tk/generic/tkMenu.c

   1 /*
   2  * tkMenu.c --
   3  *
   4  * This file contains most of the code for implementing menus in Tk. It takes
   5  * care of all of the generic (platform-independent) parts of menus, and
   6  * is supplemented by platform-specific files. The geometry calculation
   7  * and drawing code for menus is in the file tkMenuDraw.c
   8  *
   9  * Copyright (c) 1990-1994 The Regents of the University of California.
  10  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  11  *
  12  * See the file "license.terms" for information on usage and redistribution
  13  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14  *
  15  * RCS: @(#) $Id$
  16  */
  17
  18 /*
  19  * Notes on implementation of menus:
  20  *
  21  * Menus can be used in three ways:
  22  * - as a popup menu, either as part of a menubutton or standalone.
  23  * - as a menubar. The menu's cascade items are arranged according to
  24  * the specific platform to provide the user access to the menus at all
  25  * times
  26  * - as a tearoff palette. This is a window with the menu's items in it.
  27  *
  28  * The goal is to provide the Tk developer with a way to use a common
  29  * set of menus for all of these tasks.
  30  *
  31  * In order to make the bindings for cascade menus work properly under Unix,
  32  * the cascade menus' pathnames must be proper children of the menu that
  33  * they are cascade from. So if there is a menu .m, and it has two
  34  * cascades labelled "File" and "Edit", the cascade menus might have
  35  * the pathnames .m.file and .m.edit. Another constraint is that the menus
  36  * used for menubars must be children of the toplevel widget that they
  37  * are attached to. And on the Macintosh, the platform specific menu handle
  38  * for cascades attached to a menu bar must have a title that matches the
  39  * label for the cascade menu.
  40  *
  41  * To handle all of the constraints, Tk menubars and tearoff menus are
  42  * implemented using menu clones. Menu clones are full menus in their own
  43  * right; they have a Tk window and pathname associated with them; they have
  44  * a TkMenu structure and array of entries. However, they are linked with the
  45  * original menu that they were cloned from. The reflect the attributes of
  46  * the original, or "master", menu. So if an item is added to a menu, and
  47  * that menu has clones, then the item must be added to all of its clones
  48  * also. Menus are cloned when a menu is torn-off or when a menu is assigned
  49  * as a menubar using the "-menu" option of the toplevel's pathname configure
  50  * subcommand. When a clone is destroyed, only the clone is destroyed, but
  51  * when the master menu is destroyed, all clones are also destroyed. This
  52  * allows the developer to just deal with one set of menus when creating
  53  * and destroying.
  54  *
  55  * Clones are rather tricky when a menu with cascade entries is cloned (such
  56  * as a menubar). Not only does the menu have to be cloned, but each cascade
  57  * entry's corresponding menu must also be cloned. This maintains the pathname
  58  * parent-child hierarchy necessary for menubars and toplevels to work.
  59  * This leads to several special cases:
  60  *
  61  * 1. When a new menu is created, and it is pointed to by cascade entries in
  62  * cloned menus, the new menu has to be cloned to parallel the cascade
  63  * structure.
  64  * 2. When a cascade item is added to a menu that has been cloned, and the
  65  * menu that the cascade item points to exists, that menu has to be cloned.
  66  * 3. When the menu that a cascade entry points to is changed, the old
  67  * cloned cascade menu has to be discarded, and the new one has to be cloned.
  68  *
  69  */
  70
  71 #if 0
  72
  73 /*
  74  * used only to test for old config code
  75  */
  76
  77 #define __NO_OLD_CONFIG
  78 #endif
  79
  80 #include "tkPort.h"
  81 #include "tkMenu.h"
  82
  83 #define MENU_HASH_KEY "tkMenus"
  84
  85 typedef struct ThreadSpecificData {
  86     int menusInitialized;       /* Flag indicates whether thread-specific
  87                                  * elements of the Windows Menu module
  88                                  * have been initialized. */
  89 } ThreadSpecificData;
  90 static Tcl_ThreadDataKey dataKey;
  91
  92 /*
  93  * The following flag indicates whether the process-wide state for
  94  * the Menu module has been intialized.  The Mutex protects access to
  95  * that flag.
  96  */
  97
  98 static int menusInitialized;
  99 TCL_DECLARE_MUTEX(menuMutex)
 100
 101 /*
 102  * Configuration specs for individual menu entries. If this changes, be sure
 103  * to update code in TkpMenuInit that changes the font string entry.
 104  */
 105
 106 char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL};
 107
 108 static CONST char *menuEntryTypeStrings[] = {
 109     "cascade", "checkbutton", "command", "radiobutton", "separator",
 110     (char *) NULL
 111 };
 112
 113 /*
 114  * The following table defines the legal values for the -compound option.
 115  * It is used with the "enum compound" declaration in tkMenu.h
 116  */
 117
 118 static char *compoundStrings[] = {
 119     "bottom", "center", "left", "none", "right", "top", (char *) NULL
 120 };
 121
 122 Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
 123     {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
 124         DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1,
 125         TK_OPTION_NULL_OK},
 126     {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
 127         DEF_MENU_ENTRY_ACTIVE_FG,
 128         Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK},
 129     {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL,
 130         DEF_MENU_ENTRY_ACCELERATOR,
 131         Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK},
 132     {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
 133         DEF_MENU_ENTRY_BG,
 134         Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
 135     {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
 136         DEF_MENU_ENTRY_BITMAP,
 137         Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK},
 138     {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
 139         DEF_MENU_ENTRY_COLUMN_BREAK,
 140         -1, Tk_Offset(TkMenuEntry, columnBreak)},
 141     {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL,
 142         DEF_MENU_ENTRY_COMMAND,
 143         Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK},
 144     {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
 145         DEF_MENU_ENTRY_COMPOUND, -1, Tk_Offset(TkMenuEntry, compound), 0,
 146         (ClientData) compoundStrings, 0},
 147     {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL,
 148         DEF_MENU_ENTRY_FONT,
 149         Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK},
 150     {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL,
 151         DEF_MENU_ENTRY_FG,
 152         Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK},
 153     {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
 154         DEF_MENU_ENTRY_HIDE_MARGIN,
 155         -1, Tk_Offset(TkMenuEntry, hideMargin)},
 156     {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL,
 157         DEF_MENU_ENTRY_IMAGE,
 158         Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK},
 159     {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL,
 160         DEF_MENU_ENTRY_LABEL,
 161         Tk_Offset(TkMenuEntry, labelPtr), -1, 0},
 162     {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
 163         DEF_MENU_ENTRY_STATE,
 164         -1, Tk_Offset(TkMenuEntry, state), 0,
 165         (ClientData) tkMenuStateStrings},
 166     {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL,
 167         DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)},
 168     {TK_OPTION_END}
 169 };
 170
 171 Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
 172     {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
 173         DEF_MENU_ENTRY_BG,
 174         Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
 175     {TK_OPTION_END}
 176 };
 177
 178 Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {
 179     {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
 180         DEF_MENU_ENTRY_INDICATOR,
 181         -1, Tk_Offset(TkMenuEntry, indicatorOn)},
 182     {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL,
 183         DEF_MENU_ENTRY_OFF_VALUE,
 184         Tk_Offset(TkMenuEntry, offValuePtr), -1},
 185     {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL,
 186         DEF_MENU_ENTRY_ON_VALUE,
 187         Tk_Offset(TkMenuEntry, onValuePtr), -1},
 188     {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
 189         DEF_MENU_ENTRY_SELECT,
 190         Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
 191     {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
 192         DEF_MENU_ENTRY_SELECT_IMAGE,
 193         Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
 194     {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
 195         DEF_MENU_ENTRY_CHECK_VARIABLE,
 196         Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
 197     {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
 198         (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
 199 };
 200
 201 Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
 202     {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
 203         DEF_MENU_ENTRY_INDICATOR,
 204         -1, Tk_Offset(TkMenuEntry, indicatorOn)},
 205     {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
 206         DEF_MENU_ENTRY_SELECT,
 207         Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
 208     {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
 209         DEF_MENU_ENTRY_SELECT_IMAGE,
 210         Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
 211     {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL,
 212         DEF_MENU_ENTRY_VALUE,
 213         Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK},
 214     {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
 215         DEF_MENU_ENTRY_RADIO_VARIABLE,
 216         Tk_Offset(TkMenuEntry, namePtr), -1, 0},
 217     {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
 218         (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
 219 };
 220
 221 Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
 222     {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL,
 223         DEF_MENU_ENTRY_MENU,
 224         Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
 225     {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
 226         (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
 227 };
 228
 229 Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
 230     {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
 231         DEF_MENU_ENTRY_BG,
 232         Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
 233     {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
 234         DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
 235         (ClientData) tkMenuStateStrings},
 236     {TK_OPTION_END}
 237 };
 238
 239 static Tk_OptionSpec *specsArray[] = {
 240     tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
 241     tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
 242     tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs};
 243
 244 /*
 245  * Menu type strings for use with Tcl_GetIndexFromObj.
 246  */
 247
 248 static CONST char *menuTypeStrings[] = {"normal", "tearoff", "menubar",
 249         (char *) NULL};
 250
 251 Tk_OptionSpec tkMenuConfigSpecs[] = {
 252     {TK_OPTION_BORDER, "-activebackground", "activeBackground",
 253         "Foreground", DEF_MENU_ACTIVE_BG_COLOR,
 254         Tk_Offset(TkMenu, activeBorderPtr), -1, 0,
 255         (ClientData) DEF_MENU_ACTIVE_BG_MONO},
 256     {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
 257         "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
 258         Tk_Offset(TkMenu, activeBorderWidthPtr), -1},
 259     {TK_OPTION_COLOR, "-activeforeground", "activeForeground",
 260         "Background", DEF_MENU_ACTIVE_FG_COLOR,
 261         Tk_Offset(TkMenu, activeFgPtr), -1, 0,
 262         (ClientData) DEF_MENU_ACTIVE_FG_MONO},
 263     {TK_OPTION_BORDER, "-background", "background", "Background",
 264         DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0,
 265         (ClientData) DEF_MENU_BG_MONO},
 266     {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
 267         (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
 268     {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
 269         (char *) NULL, 0, -1, 0, (ClientData) "-background"},
 270     {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
 271         DEF_MENU_BORDER_WIDTH,
 272         Tk_Offset(TkMenu, borderWidthPtr), -1, 0},
 273     {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
 274         DEF_MENU_CURSOR,
 275         Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK},
 276     {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
 277         "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
 278         Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,
 279         (ClientData) DEF_MENU_DISABLED_FG_MONO},
 280     {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
 281         (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
 282     {TK_OPTION_FONT, "-font", "font", "Font",
 283         DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1},
 284     {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
 285         DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1},
 286     {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
 287         DEF_MENU_POST_COMMAND,
 288         Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK},
 289     {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
 290         DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1},
 291     {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
 292         DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,
 293         (ClientData) DEF_MENU_SELECT_MONO},
 294     {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
 295         DEF_MENU_TAKE_FOCUS,
 296         Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK},
 297     {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
 298         DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)},
 299     {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",
 300         "TearOffCommand", DEF_MENU_TEAROFF_CMD,
 301         Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK},
 302     {TK_OPTION_STRING, "-title", "title", "Title",
 303         DEF_MENU_TITLE,  Tk_Offset(TkMenu, titlePtr), -1,
 304         TK_OPTION_NULL_OK},
 305     {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
 306         DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
 307         (ClientData) menuTypeStrings},
 308     {TK_OPTION_END}
 309 };
 310
 311 /*
 312  * Command line options. Put here because MenuCmd has to look at them
 313  * along with MenuWidgetObjCmd.
 314  */
 315
 316 static CONST char *menuOptions[] = {
 317     "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
 318     "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
 319     "type", "unpost", "yposition", (char *) NULL
 320 };
 321 enum options {
 322     MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
 323     MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
 324     MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
 325     MENU_UNPOST, MENU_YPOSITION
 326 };
 327
 328 /*
 329  * Prototypes for static procedures in this file:
 330  */
 331
 332 static int              CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
 333                             Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString));
 334 static int              ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
 335                             TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[]));
 336 static int              ConfigureMenuCloneEntries _ANSI_ARGS_((
 337                             Tcl_Interp *interp, TkMenu *menuPtr, int index,
 338                             int objc, Tcl_Obj *CONST objv[]));
 339 static int              ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
 340                             int objc, Tcl_Obj *CONST objv[]));
 341 static void             DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
 342                             int first, int last));
 343 static void             DestroyMenuHashTable _ANSI_ARGS_((
 344                             ClientData clientData, Tcl_Interp *interp));
 345 static void             DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
 346 static void             DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
 347 static int              GetIndexFromCoords
 348                             _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
 349                             char *string, int *indexPtr));
 350 static int              MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
 351                             TkMenu *menuPtr, Tcl_Obj *objPtr));
 352 static int              MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
 353                             TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
 354                             Tcl_Obj *CONST objv[]));
 355 static int              MenuCmd _ANSI_ARGS_((ClientData clientData,
 356                             Tcl_Interp *interp, int objc,
 357                             Tcl_Obj *CONST objv[]));
 358 static void             MenuCmdDeletedProc _ANSI_ARGS_((
 359                             ClientData clientData));
 360 static TkMenuEntry *    MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
 361                             int type));
 362 static char *           MenuVarProc _ANSI_ARGS_((ClientData clientData,
 363                             Tcl_Interp *interp, CONST char *name1,
 364                             CONST char *name2, int flags));
 365 static int              MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
 366                             Tcl_Interp *interp, int objc,
 367                             Tcl_Obj *CONST objv[]));
 368 static void             MenuWorldChanged _ANSI_ARGS_((
 369                             ClientData instanceData));
 370 static int              PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
 371 static void             RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
 372 static void             UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
 373
 374 /*
 375  * The structure below is a list of procs that respond to certain window
 376  * manager events. One of these includes a font change, which forces
 377  * the geometry proc to be called.
 378  */
 379
 380 static Tk_ClassProcs menuClass = {
 381     sizeof(Tk_ClassProcs),      /* size */
 382     MenuWorldChanged            /* worldChangedProc */
 383 };
 384 \f
 385 /*
 386  *--------------------------------------------------------------
 387  *
 388  * TkCreateMenuCmd --
 389  *
 390  *      Called by Tk at initialization time to create the menu
 391  *      command.
 392  *
 393  * Results:
 394  *      A standard Tcl result.
 395  *
 396  * Side effects:
 397  *      See the user documentation.
 398  *
 399  *--------------------------------------------------------------
 400  */
 401
 402 int
 403 TkCreateMenuCmd(interp)
 404     Tcl_Interp *interp;         /* Interpreter we are creating the
 405                                  * command in. */
 406 {
 407     TkMenuOptionTables *optionTablesPtr =
 408             (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables));
 409
 410     optionTablesPtr->menuOptionTable =
 411             Tk_CreateOptionTable(interp, tkMenuConfigSpecs);
 412     optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] =
 413             Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]);
 414     optionTablesPtr->entryOptionTables[COMMAND_ENTRY] =
 415             Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]);
 416     optionTablesPtr->entryOptionTables[CASCADE_ENTRY] =
 417             Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]);
 418     optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] =
 419             Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]);
 420     optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
 421             Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]);
 422     optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
 423             Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]);
 424
 425     Tcl_CreateObjCommand(interp, "menu", MenuCmd,
 426             (ClientData) optionTablesPtr, NULL);
 427
 428     if (Tcl_IsSafe(interp)) {
 429         Tcl_HideCommand(interp, "menu", "menu");
 430     }
 431
 432     return TCL_OK;
 433 }
 434 \f
 435 /*
 436  *--------------------------------------------------------------
 437  *
 438  * MenuCmd --
 439  *
 440  *      This procedure is invoked to process the "menu" Tcl
 441  *      command.  See the user documentation for details on
 442  *      what it does.
 443  *
 444  * Results:
 445  *      A standard Tcl result.
 446  *
 447  * Side effects:
 448  *      See the user documentation.
 449  *
 450  *--------------------------------------------------------------
 451  */
 452
 453 static int
 454 MenuCmd(clientData, interp, objc, objv)
 455     ClientData clientData;      /* Main window associated with
 456                                  * interpreter. */
 457     Tcl_Interp *interp;         /* Current interpreter. */
 458     int objc;                   /* Number of arguments. */
 459     Tcl_Obj *CONST objv[];      /* Argument strings. */
 460 {
 461     Tk_Window tkwin = Tk_MainWindow(interp);
 462     Tk_Window new;
 463     register TkMenu *menuPtr;
 464     TkMenuReferences *menuRefPtr;
 465     int i, index;
 466     int toplevel;
 467     char *windowName;
 468     static CONST char *typeStringList[] = {"-type", (char *) NULL};
 469     TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData;
 470
 471     if (objc < 2) {
 472         Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
 473         return TCL_ERROR;
 474     }
 475
 476     TkMenuInit();
 477
 478     toplevel = 1;
 479     for (i = 2; i < (objc - 1); i++) {
 480         if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index)
 481                 != TCL_ERROR) {
 482             if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL,
 483                     0, &index) == TCL_OK) && (index == MENUBAR)) {
 484                 toplevel = 0;
 485             }
 486             break;
 487         }
 488     }
 489
 490     windowName = Tcl_GetStringFromObj(objv[1], NULL);
 491     new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? ""
 492             : NULL);
 493     if (new == NULL) {
 494         return TCL_ERROR;
 495     }
 496
 497     /*
 498      * Initialize the data structure for the menu.
 499      */
 500
 501     menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
 502     menuPtr->tkwin = new;
 503     menuPtr->display = Tk_Display(new);
 504     menuPtr->interp = interp;
 505     menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
 506             Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd,
 507             (ClientData) menuPtr, MenuCmdDeletedProc);
 508     menuPtr->entries = NULL;
 509     menuPtr->numEntries = 0;
 510     menuPtr->active = -1;
 511     menuPtr->borderPtr = NULL;
 512     menuPtr->borderWidthPtr = NULL;
 513     menuPtr->reliefPtr = NULL;
 514     menuPtr->activeBorderPtr = NULL;
 515     menuPtr->activeBorderWidthPtr = NULL;
 516     menuPtr->fontPtr = NULL;
 517     menuPtr->fgPtr = NULL;
 518     menuPtr->disabledFgPtr = NULL;
 519     menuPtr->activeFgPtr = NULL;
 520     menuPtr->indicatorFgPtr = NULL;
 521     menuPtr->tearoff = 0;
 522     menuPtr->tearoffCommandPtr = NULL;
 523     menuPtr->cursorPtr = None;
 524     menuPtr->takeFocusPtr = NULL;
 525     menuPtr->postCommandPtr = NULL;
 526     menuPtr->postCommandGeneration = 0;
 527     menuPtr->postedCascade = NULL;
 528     menuPtr->nextInstancePtr = NULL;
 529     menuPtr->masterMenuPtr = menuPtr;
 530     menuPtr->menuType = UNKNOWN_TYPE;
 531     menuPtr->menuFlags = 0;
 532     menuPtr->parentTopLevelPtr = NULL;
 533     menuPtr->menuTypePtr = NULL;
 534     menuPtr->titlePtr = NULL;
 535     menuPtr->errorStructPtr = NULL;
 536     menuPtr->optionTablesPtr = optionTablesPtr;
 537     TkMenuInitializeDrawingFields(menuPtr);
 538
 539     Tk_SetClass(menuPtr->tkwin, "Menu");
 540     Tk_SetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
 541     if (Tk_InitOptions(interp, (char *) menuPtr,
 542             menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin)
 543             != TCL_OK) {
 544         Tk_DestroyWindow(menuPtr->tkwin);
 545         ckfree((char *) menuPtr);
 546         return TCL_ERROR;
 547     }
 548
 549
 550     menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
 551             Tk_PathName(menuPtr->tkwin));
 552     menuRefPtr->menuPtr = menuPtr;
 553     menuPtr->menuRefPtr = menuRefPtr;
 554     if (TCL_OK != TkpNewMenu(menuPtr)) {
 555         Tk_DestroyWindow(menuPtr->tkwin);
 556         ckfree((char *) menuPtr);
 557         return TCL_ERROR;
 558     }
 559
 560     Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
 561             TkMenuEventProc, (ClientData) menuPtr);
 562     if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
 563         Tk_DestroyWindow(menuPtr->tkwin);
 564         return TCL_ERROR;
 565     }
 566
 567     /*
 568      * If a menu has a parent menu pointing to it as a cascade entry, the
 569      * parent menu needs to be told that this menu now exists so that
 570      * the platform-part of the menu is correctly updated.
 571      *
 572      * If a menu has an instance and has cascade entries, then each cascade
 573      * menu must also have a parallel instance. This is especially true on
 574      * the Mac, where each menu has to have a separate title everytime it is in
 575      * a menubar. For instance, say you have a menu .m1 with a cascade entry
 576      * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar.
 577      * This creates a menubar instance for .m1, but since .m2 is not there,
 578      * nothing else happens. When we go to create .m2, we hook it up properly
 579      * with .m1. However, we now need to clone .m2 and assign the clone of .m2
 580      * to be the cascade entry for the clone of .m1. This is special case
 581      * #1 listed in the introductory comment.
 582      */
 583
 584     if (menuRefPtr->parentEntryPtr != NULL) {
 585         TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
 586         TkMenuEntry *nextCascadePtr;
 587         Tcl_Obj *newMenuName;
 588         Tcl_Obj *newObjv[2];
 589
 590         while (cascadeListPtr != NULL) {
 591
 592             nextCascadePtr = cascadeListPtr->nextCascadePtr;
 593
 594             /*
 595              * If we have a new master menu, and an existing cloned menu
 596              * points to this menu in a cascade entry, we have to clone
 597              * the new menu and point the entry to the clone instead
 598              * of the menu we are creating. Otherwise, ConfigureMenuEntry
 599              * will hook up the platform-specific cascade linkages now
 600              * that the menu we are creating exists.
 601              */
 602
 603             if ((menuPtr->masterMenuPtr != menuPtr)
 604                     || ((menuPtr->masterMenuPtr == menuPtr)
 605                     && ((cascadeListPtr->menuPtr->masterMenuPtr
 606                     == cascadeListPtr->menuPtr)))) {
 607                 newObjv[0] = Tcl_NewStringObj("-menu", -1);
 608                 newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
 609                 Tcl_IncrRefCount(newObjv[0]);
 610                 Tcl_IncrRefCount(newObjv[1]);
 611                 ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
 612                 Tcl_DecrRefCount(newObjv[0]);
 613                 Tcl_DecrRefCount(newObjv[1]);
 614             } else {
 615                 Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
 616                 Tcl_Obj *windowNamePtr = Tcl_NewStringObj(
 617                         Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1);
 618
 619                 Tcl_IncrRefCount(normalPtr);
 620                 Tcl_IncrRefCount(windowNamePtr);
 621                 newMenuName = TkNewMenuName(menuPtr->interp,
 622                         windowNamePtr, menuPtr);
 623                 Tcl_IncrRefCount(newMenuName);
 624                 CloneMenu(menuPtr, newMenuName, normalPtr);
 625
 626                 /*
 627                  * Now we can set the new menu instance to be the cascade entry
 628                  * of the parent's instance.
 629                  */
 630
 631                 newObjv[0] = Tcl_NewStringObj("-menu", -1);
 632                 newObjv[1] = newMenuName;
 633                 Tcl_IncrRefCount(newObjv[0]);
 634                 ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
 635                 Tcl_DecrRefCount(normalPtr);
 636                 Tcl_DecrRefCount(newObjv[0]);
 637                 Tcl_DecrRefCount(newObjv[1]);
 638                 Tcl_DecrRefCount(windowNamePtr);
 639             }
 640             cascadeListPtr = nextCascadePtr;
 641         }
 642     }
 643
 644     /*
 645      * If there already exist toplevel widgets that refer to this menu,
 646      * find them and notify them so that they can reconfigure their
 647      * geometry to reflect the menu.
 648      */
 649
 650     if (menuRefPtr->topLevelListPtr != NULL) {
 651         TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr;
 652         TkMenuTopLevelList *nextPtr;
 653         Tk_Window listtkwin;
 654         while (topLevelListPtr != NULL) {
 655
 656             /*
 657              * Need to get the next pointer first. TkSetWindowMenuBar
 658              * changes the list, so that the next pointer is different
 659              * after calling it.
 660              */
 661
 662             nextPtr = topLevelListPtr->nextPtr;
 663             listtkwin = topLevelListPtr->tkwin;
 664             TkSetWindowMenuBar(menuPtr->interp, listtkwin,
 665                     Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
 666             topLevelListPtr = nextPtr;
 667         }
 668     }
 669
 670     Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC);
 671     return TCL_OK;
 672 }
 673 \f
 674 /*
 675  *--------------------------------------------------------------
 676  *
 677  * MenuWidgetObjCmd --
 678  *
 679  *      This procedure is invoked to process the Tcl command
 680  *      that corresponds to a widget managed by this module.
 681  *      See the user documentation for details on what it does.
 682  *
 683  * Results:
 684  *      A standard Tcl result.
 685  *
 686  * Side effects:
 687  *      See the user documentation.
 688  *
 689  *--------------------------------------------------------------
 690  */
 691
 692 static int
 693 MenuWidgetObjCmd(clientData, interp, objc, objv)
 694     ClientData clientData;      /* Information about menu widget. */
 695     Tcl_Interp *interp;         /* Current interpreter. */
 696     int objc;                   /* Number of arguments. */
 697     Tcl_Obj *CONST objv[];      /* Argument strings. */
 698 {
 699     register TkMenu *menuPtr = (TkMenu *) clientData;
 700     register TkMenuEntry *mePtr;
 701     int result = TCL_OK;
 702     int option;
 703
 704     if (objc < 2) {
 705         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 706         return TCL_ERROR;
 707     }
 708     if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0,
 709             &option) != TCL_OK) {
 710         return TCL_ERROR;
 711     }
 712     Tcl_Preserve((ClientData) menuPtr);
 713
 714     switch ((enum options) option) {
 715         case MENU_ACTIVATE: {
 716             int index;
 717
 718             if (objc != 3) {
 719                 Tcl_WrongNumArgs(interp, 1, objv, "activate index");
 720                 goto error;
 721             }
 722             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 723                     != TCL_OK) {
 724                 goto error;
 725             }
 726             if (menuPtr->active == index) {
 727                 goto done;
 728             }
 729             if ((index >= 0)
 730                     && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
 731                             || (menuPtr->entries[index]->state
 732                                     == ENTRY_DISABLED))) {
 733                 index = -1;
 734             }
 735             result = TkActivateMenuEntry(menuPtr, index);
 736             break;
 737         }
 738         case MENU_ADD:
 739             if (objc < 3) {
 740                 Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?");
 741                 goto error;
 742             }
 743
 744             if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL,
 745                     objc - 2, objv + 2) != TCL_OK) {
 746                 goto error;
 747             }
 748             break;
 749         case MENU_CGET: {
 750             Tcl_Obj *resultPtr;
 751
 752             if (objc != 3) {
 753                 Tcl_WrongNumArgs(interp, 1, objv, "cget option");
 754                 goto error;
 755             }
 756             resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr,
 757                     menuPtr->optionTablesPtr->menuOptionTable, objv[2],
 758                     menuPtr->tkwin);
 759             if (resultPtr == NULL) {
 760                 goto error;
 761             }
 762             Tcl_SetObjResult(interp, resultPtr);
 763             break;
 764         }
 765         case MENU_CLONE:
 766             if ((objc < 3) || (objc > 4)) {
 767                 Tcl_WrongNumArgs(interp, 1, objv,
 768                         "clone newMenuName ?menuType?");
 769                 goto error;
 770             }
 771             result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]);
 772             break;
 773         case MENU_CONFIGURE: {
 774             Tcl_Obj *resultPtr;
 775
 776             if (objc == 2) {
 777                 resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
 778                         menuPtr->optionTablesPtr->menuOptionTable,
 779                         (Tcl_Obj *) NULL, menuPtr->tkwin);
 780                 if (resultPtr == NULL) {
 781                     result = TCL_ERROR;
 782                 } else {
 783                     result = TCL_OK;
 784                     Tcl_SetObjResult(interp, resultPtr);
 785                 }
 786             } else if (objc == 3) {
 787                 resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
 788                         menuPtr->optionTablesPtr->menuOptionTable,
 789                         objv[2], menuPtr->tkwin);
 790                 if (resultPtr == NULL) {
 791                     result = TCL_ERROR;
 792                 } else {
 793                     result = TCL_OK;
 794                     Tcl_SetObjResult(interp, resultPtr);
 795                 }
 796             } else {
 797                 result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2);
 798             }
 799             if (result != TCL_OK) {
 800                 goto error;
 801             }
 802             break;
 803         }
 804         case MENU_DELETE: {
 805             int first, last;
 806
 807             if ((objc != 3) && (objc != 4)) {
 808                 Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?");
 809                 goto error;
 810             }
 811             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first)
 812                     != TCL_OK) {
 813                 goto error;
 814             }
 815             if (objc == 3) {
 816                 last = first;
 817             } else {
 818                 if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last)
 819                         != TCL_OK) {
 820                     goto error;
 821                 }
 822             }
 823             if (menuPtr->tearoff && (first == 0)) {
 824
 825                 /*
 826                  * Sorry, can't delete the tearoff entry;  must reconfigure
 827                  * the menu.
 828                  */
 829
 830                 first = 1;
 831             }
 832             if ((first < 0) || (last < first)) {
 833                 goto done;
 834             }
 835             DeleteMenuCloneEntries(menuPtr, first, last);
 836             break;
 837         }
 838         case MENU_ENTRYCGET: {
 839             int index;
 840             Tcl_Obj *resultPtr;
 841
 842             if (objc != 4) {
 843                 Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option");
 844                 goto error;
 845             }
 846             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 847                     != TCL_OK) {
 848                 goto error;
 849             }
 850             if (index < 0) {
 851                 goto done;
 852             }
 853             mePtr = menuPtr->entries[index];
 854             Tcl_Preserve((ClientData) mePtr);
 855             resultPtr = Tk_GetOptionValue(interp, (char *) mePtr,
 856                     mePtr->optionTable, objv[3], menuPtr->tkwin);
 857             Tcl_Release((ClientData) mePtr);
 858             if (resultPtr == NULL) {
 859                 goto error;
 860             }
 861             Tcl_SetObjResult(interp, resultPtr);
 862             break;
 863         }
 864         case MENU_ENTRYCONFIGURE: {
 865             int index;
 866             Tcl_Obj *resultPtr;
 867
 868             if (objc < 3) {
 869                 Tcl_WrongNumArgs(interp, 1, objv,
 870                         "entryconfigure index ?option value ...?");
 871                 goto error;
 872             }
 873             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 874                     != TCL_OK) {
 875                 goto error;
 876             }
 877             if (index < 0) {
 878                 goto done;
 879             }
 880             mePtr = menuPtr->entries[index];
 881             Tcl_Preserve((ClientData) mePtr);
 882             if (objc == 3) {
 883                 resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
 884                         mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin);
 885                 if (resultPtr == NULL) {
 886                     result = TCL_ERROR;
 887                 } else {
 888                     result = TCL_OK;
 889                     Tcl_SetObjResult(interp, resultPtr);
 890                 }
 891             } else if (objc == 4) {
 892                 resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
 893                         mePtr->optionTable, objv[3], menuPtr->tkwin);
 894                 if (resultPtr == NULL) {
 895                     result = TCL_ERROR;
 896                 } else {
 897                     result = TCL_OK;
 898                     Tcl_SetObjResult(interp, resultPtr);
 899                 }
 900             } else {
 901                 result = ConfigureMenuCloneEntries(interp, menuPtr, index,
 902                         objc - 3, objv + 3);
 903             }
 904             Tcl_Release((ClientData) mePtr);
 905             break;
 906         }
 907         case MENU_INDEX: {
 908             int index;
 909
 910             if (objc != 3) {
 911                 Tcl_WrongNumArgs(interp, 1, objv, "index string");
 912                 goto error;
 913             }
 914             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 915                     != TCL_OK) {
 916                 goto error;
 917             }
 918             if (index < 0) {
 919                 Tcl_SetResult(interp, "none", TCL_STATIC);
 920             } else {
 921                 Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
 922             }
 923             break;
 924         }
 925         case MENU_INSERT:
 926             if (objc < 4) {
 927                 Tcl_WrongNumArgs(interp, 1, objv,
 928                         "insert index type ?options?");
 929                 goto error;
 930             }
 931             if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3,
 932                     objv + 3) != TCL_OK) {
 933                 goto error;
 934             }
 935             break;
 936         case MENU_INVOKE: {
 937             int index;
 938
 939             if (objc != 3) {
 940                 Tcl_WrongNumArgs(interp, 1, objv, "invoke index");
 941                 goto error;
 942             }
 943             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 944                     != TCL_OK) {
 945                 goto error;
 946             }
 947             if (index < 0) {
 948                 goto done;
 949             }
 950             result = TkInvokeMenu(interp, menuPtr, index);
 951             break;
 952         }
 953         case MENU_POST: {
 954             int x, y;
 955
 956             if (objc != 4) {
 957                 Tcl_WrongNumArgs(interp, 1, objv, "post x y");
 958                 goto error;
 959             }
 960             if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
 961                     || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
 962                 goto error;
 963             }
 964
 965             /*
 966              * Tearoff menus are posted differently on Mac and Windows than
 967              * non-tearoffs. TkpPostMenu does not actually map the menu's
 968              * window on those platforms, and popup menus have to be
 969              * handled specially.
 970              */
 971
 972             if (menuPtr->menuType != TEAROFF_MENU) {
 973                 result = TkpPostMenu(interp, menuPtr, x, y);
 974             } else {
 975                 result = TkPostTearoffMenu(interp, menuPtr, x, y);
 976             }
 977             break;
 978         }
 979         case MENU_POSTCASCADE: {
 980             int index;
 981
 982             if (objc != 3) {
 983                 Tcl_WrongNumArgs(interp, 1, objv, "postcascade index");
 984                 goto error;
 985             }
 986
 987             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
 988                     != TCL_OK) {
 989                 goto error;
 990             }
 991             if ((index < 0) || (menuPtr->entries[index]->type
 992                     != CASCADE_ENTRY)) {
 993                 result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
 994             } else {
 995                 result = TkPostSubmenu(interp, menuPtr,
 996                         menuPtr->entries[index]);
 997             }
 998             break;
 999         }
1000         case MENU_TYPE: {
1001             int index;
1002
1003             if (objc != 3) {
1004                 Tcl_WrongNumArgs(interp, 1, objv, "type index");
1005                 goto error;
1006             }
1007             if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
1008                     != TCL_OK) {
1009                 goto error;
1010             }
1011             if (index < 0) {
1012                 goto done;
1013             }
1014             if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
1015                 Tcl_SetResult(interp, "tearoff", TCL_STATIC);
1016             } else {
1017                 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1018                         menuEntryTypeStrings[menuPtr->entries[index]->type],
1019                         -1);
1020             }
1021             break;
1022         }
1023         case MENU_UNPOST:
1024             if (objc != 2) {
1025                 Tcl_WrongNumArgs(interp, 1, objv, "unpost");
1026                 goto error;
1027             }
1028             Tk_UnmapWindow(menuPtr->tkwin);
1029             result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
1030             break;
1031         case MENU_YPOSITION:
1032             if (objc != 3) {
1033                 Tcl_WrongNumArgs(interp, 1, objv, "yposition index");
1034                 goto error;
1035             }
1036             result = MenuDoYPosition(interp, menuPtr, objv[2]);
1037             break;
1038     }
1039     done:
1040     Tcl_Release((ClientData) menuPtr);
1041     return result;
1042
1043     error:
1044     Tcl_Release((ClientData) menuPtr);
1045     return TCL_ERROR;
1046 }
1047 \f
1048 /*
1049  *----------------------------------------------------------------------
1050  *
1051  * TkInvokeMenu --
1052  *
1053  *      Given a menu and an index, takes the appropriate action for the
1054  *      entry associated with that index.
1055  *
1056  * Results:
1057  *      Standard Tcl result.
1058  *
1059  * Side effects:
1060  *      Commands may get excecuted; variables may get set; sub-menus may
1061  *      get posted.
1062  *
1063  *----------------------------------------------------------------------
1064  */
1065
1066 int
1067 TkInvokeMenu(interp, menuPtr, index)
1068     Tcl_Interp *interp;         /* The interp that the menu lives in. */
1069     TkMenu *menuPtr;            /* The menu we are invoking. */
1070     int index;                  /* The zero based index of the item we
1071                                  * are invoking */
1072 {
1073     int result = TCL_OK;
1074     TkMenuEntry *mePtr;
1075
1076     if (index < 0) {
1077         goto done;
1078     }
1079     mePtr = menuPtr->entries[index];
1080     if (mePtr->state == ENTRY_DISABLED) {
1081         goto done;
1082     }
1083     Tcl_Preserve((ClientData) mePtr);
1084     if (mePtr->type == TEAROFF_ENTRY) {
1085         Tcl_DString ds;
1086         Tcl_DStringInit(&ds);
1087         Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1);
1088         Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
1089         result = Tcl_Eval(interp, Tcl_DStringValue(&ds));
1090         Tcl_DStringFree(&ds);
1091     } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
1092             && (mePtr->namePtr != NULL)) {
1093         Tcl_Obj *valuePtr;
1094
1095         if (mePtr->entryFlags & ENTRY_SELECTED) {
1096             valuePtr = mePtr->offValuePtr;
1097         } else {
1098             valuePtr = mePtr->onValuePtr;
1099         }
1100         if (valuePtr == NULL) {
1101             valuePtr = Tcl_NewObj();
1102         }
1103         Tcl_IncrRefCount(valuePtr);
1104         if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
1105                 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
1106             result = TCL_ERROR;
1107         }
1108         Tcl_DecrRefCount(valuePtr);
1109     } else if ((mePtr->type == RADIO_BUTTON_ENTRY)
1110             && (mePtr->namePtr != NULL)) {
1111         Tcl_Obj *valuePtr = mePtr->onValuePtr;
1112
1113         if (valuePtr == NULL) {
1114             valuePtr = Tcl_NewObj();
1115         }
1116         Tcl_IncrRefCount(valuePtr);
1117         if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
1118                 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
1119             result = TCL_ERROR;
1120         }
1121         Tcl_DecrRefCount(valuePtr);
1122     }
1123     /*
1124      * We check numEntries in addition to whether the menu entry
1125      * has a command because that goes to zero if the menu gets
1126      * deleted (e.g., during command evaluation).
1127      */
1128     if ((menuPtr->numEntries != 0) && (result == TCL_OK)
1129             && (mePtr->commandPtr != NULL)) {
1130         Tcl_Obj *commandPtr = mePtr->commandPtr;
1131
1132         Tcl_IncrRefCount(commandPtr);
1133         result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
1134         Tcl_DecrRefCount(commandPtr);
1135     }
1136     Tcl_Release((ClientData) mePtr);
1137     done:
1138     return result;
1139 }
1140 \f
1141 /*
1142  *----------------------------------------------------------------------
1143  *
1144  * DestroyMenuInstance --
1145  *
1146  *      This procedure is invoked by TkDestroyMenu
1147  *      to clean up the internal structure of a menu at a safe time
1148  *      (when no-one is using it anymore). Only takes care of one instance
1149  *      of the menu.
1150  *
1151  * Results:
1152  *      None.
1153  *
1154  * Side effects:
1155  *      Everything associated with the menu is freed up.
1156  *
1157  *----------------------------------------------------------------------
1158  */
1159
1160 static void
1161 DestroyMenuInstance(menuPtr)
1162     TkMenu *menuPtr;    /* Info about menu widget. */
1163 {
1164     int i;
1165     TkMenu *menuInstancePtr;
1166     TkMenuEntry *cascadePtr, *nextCascadePtr;
1167     Tcl_Obj *newObjv[2];
1168     TkMenu *parentMasterMenuPtr;
1169     TkMenuEntry *parentMasterEntryPtr;
1170
1171     /*
1172      * If the menu has any cascade menu entries pointing to it, the cascade
1173      * entries need to be told that the menu is going away. We need to clear
1174      * the menu ptr field in the menu reference at this point in the code
1175      * so that everything else can forget about this menu properly. We also
1176      * need to reset -menu field of all entries that are not master menus
1177      * back to this entry name if this is a master menu pointed to by another
1178      * master menu. If there is a clone menu that points to this menu,
1179      * then this menu is itself a clone, so when this menu goes away,
1180      * the -menu field of the pointing entry must be set back to this
1181      * menu's master menu name so that later if another menu is created
1182      * the cascade hierarchy can be maintained.
1183      */
1184
1185     TkpDestroyMenu(menuPtr);
1186     cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
1187     menuPtr->menuRefPtr->menuPtr = NULL;
1188     TkFreeMenuReferences(menuPtr->menuRefPtr);
1189
1190     for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
1191         nextCascadePtr = cascadePtr->nextCascadePtr;
1192
1193         if (menuPtr->masterMenuPtr != menuPtr) {
1194             Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
1195
1196             parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
1197             parentMasterEntryPtr =
1198                     parentMasterMenuPtr->entries[cascadePtr->index];
1199             newObjv[0] = menuNamePtr;
1200             newObjv[1] = parentMasterEntryPtr->namePtr;
1201             /*
1202              * It is possible that the menu info is out of sync, and
1203              * these things point to NULL, so verify existence [Bug: 3402]
1204              */
1205             if (newObjv[0] && newObjv[1]) {
1206                 Tcl_IncrRefCount(newObjv[0]);
1207                 Tcl_IncrRefCount(newObjv[1]);
1208                 ConfigureMenuEntry(cascadePtr, 2, newObjv);
1209                 Tcl_DecrRefCount(newObjv[0]);
1210                 Tcl_DecrRefCount(newObjv[1]);
1211             }
1212         } else {
1213             ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL);
1214         }
1215     }
1216
1217     if (menuPtr->masterMenuPtr != menuPtr) {
1218         for (menuInstancePtr = menuPtr->masterMenuPtr;
1219                 menuInstancePtr != NULL;
1220                 menuInstancePtr = menuInstancePtr->nextInstancePtr) {
1221             if (menuInstancePtr->nextInstancePtr == menuPtr) {
1222                 menuInstancePtr->nextInstancePtr =
1223                         menuInstancePtr->nextInstancePtr->nextInstancePtr;
1224                 break;
1225             }
1226         }
1227    } else if (menuPtr->nextInstancePtr != NULL) {
1228        panic("Attempting to delete master menu when there are still clones.");
1229    }
1230
1231     /*
1232      * Free up all the stuff that requires special handling, then
1233      * let Tk_FreeConfigOptions handle all the standard option-related
1234      * stuff.
1235      */
1236
1237     for (i = menuPtr->numEntries; --i >= 0; ) {
1238         /*
1239          * As each menu entry is deleted from the end of the array of
1240          * entries, decrement menuPtr->numEntries.  Otherwise, the act of
1241          * deleting menu entry i will dereference freed memory attempting
1242          * to queue a redraw for menu entries (i+1)...numEntries.
1243          */
1244
1245         DestroyMenuEntry((char *) menuPtr->entries[i]);
1246         menuPtr->numEntries = i;
1247     }
1248     if (menuPtr->entries != NULL) {
1249         ckfree((char *) menuPtr->entries);
1250     }
1251     TkMenuFreeDrawOptions(menuPtr);
1252     Tk_FreeConfigOptions((char *) menuPtr,
1253             menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin);
1254 }
1255 \f
1256 /*
1257  *----------------------------------------------------------------------
1258  *
1259  * TkDestroyMenu --
1260  *
1261  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
1262  *      to clean up the internal structure of a menu at a safe time
1263  *      (when no-one is using it anymore).  If called on a master instance,
1264  *      destroys all of the slave instances. If called on a non-master
1265  *      instance, just destroys that instance.
1266  *
1267  * Results:
1268  *      None.
1269  *
1270  * Side effects:
1271  *      Everything associated with the menu is freed up.
1272  *
1273  *----------------------------------------------------------------------
1274  */
1275
1276 void
1277 TkDestroyMenu(menuPtr)
1278     TkMenu *menuPtr;    /* Info about menu widget. */
1279 {
1280     TkMenu *menuInstancePtr;
1281     TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr;
1282
1283     if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
1284         return;
1285     }
1286
1287     /*
1288      * Now destroy all non-tearoff instances of this menu if this is a
1289      * parent menu. Is this loop safe enough? Are there going to be
1290      * destroy bindings on child menus which kill the parent? If not,
1291      * we have to do a slightly more complex scheme.
1292      */
1293
1294     if (menuPtr->masterMenuPtr == menuPtr) {
1295         menuPtr->menuFlags |= MENU_DELETION_PENDING;
1296         while (menuPtr->nextInstancePtr != NULL) {
1297             menuInstancePtr = menuPtr->nextInstancePtr;
1298             menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr;
1299             if (menuInstancePtr->tkwin != NULL) {
1300                 Tk_DestroyWindow(menuInstancePtr->tkwin);
1301             }
1302         }
1303         menuPtr->menuFlags &= ~MENU_DELETION_PENDING;
1304     }
1305
1306     /*
1307      * If any toplevel widgets have this menu as their menubar,
1308      * the geometry of the window may have to be recalculated.
1309      */
1310
1311     topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr;
1312     while (topLevelListPtr != NULL) {
1313          nextTopLevelPtr = topLevelListPtr->nextPtr;
1314          TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL);
1315          topLevelListPtr = nextTopLevelPtr;
1316     }
1317     DestroyMenuInstance(menuPtr);
1318 }
1319 \f
1320 /*
1321  *----------------------------------------------------------------------
1322  *
1323  * UnhookCascadeEntry --
1324  *
1325  *      This entry is removed from the list of entries that point to the
1326  *      cascade menu. This is done in preparation for changing the menu
1327  *      that this entry points to.
1328  *
1329  * Results:
1330  *      None
1331  *
1332  * Side effects:
1333  *      The appropriate lists are modified.
1334  *
1335  *----------------------------------------------------------------------
1336  */
1337
1338 static void
1339 UnhookCascadeEntry(mePtr)
1340     TkMenuEntry *mePtr;                 /* The cascade entry we are removing
1341                                          * from the cascade list. */
1342 {
1343     TkMenuEntry *cascadeEntryPtr;
1344     TkMenuEntry *prevCascadePtr;
1345     TkMenuReferences *menuRefPtr;
1346
1347     menuRefPtr = mePtr->childMenuRefPtr;
1348     if (menuRefPtr == NULL) {
1349         return;
1350     }
1351
1352     cascadeEntryPtr = menuRefPtr->parentEntryPtr;
1353     if (cascadeEntryPtr == NULL) {
1354         return;
1355     }
1356
1357     /*
1358      * Singularly linked list deletion. The two special cases are
1359      * 1. one element; 2. The first element is the one we want.
1360      */
1361
1362     if (cascadeEntryPtr == mePtr) {
1363         if (cascadeEntryPtr->nextCascadePtr == NULL) {
1364
1365             /*
1366              * This is the last menu entry which points to this
1367              * menu, so we need to clear out the list pointer in the
1368              * cascade itself.
1369              */
1370
1371             menuRefPtr->parentEntryPtr = NULL;
1372             TkFreeMenuReferences(menuRefPtr);
1373         } else {
1374             menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr;
1375         }
1376         mePtr->nextCascadePtr = NULL;
1377     } else {
1378         for (prevCascadePtr = cascadeEntryPtr,
1379                 cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr;
1380                 cascadeEntryPtr != NULL;
1381                 prevCascadePtr = cascadeEntryPtr,
1382                 cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
1383             if (cascadeEntryPtr == mePtr){
1384                 prevCascadePtr->nextCascadePtr =
1385                         cascadeEntryPtr->nextCascadePtr;
1386                 cascadeEntryPtr->nextCascadePtr = NULL;
1387                 break;
1388             }
1389         }
1390     }
1391     mePtr->childMenuRefPtr = NULL;
1392 }
1393 \f
1394 /*
1395  *----------------------------------------------------------------------
1396  *
1397  * DestroyMenuEntry --
1398  *
1399  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
1400  *      to clean up the internal structure of a menu entry at a safe time
1401  *      (when no-one is using it anymore).
1402  *
1403  * Results:
1404  *      None.
1405  *
1406  * Side effects:
1407  *      Everything associated with the menu entry is freed.
1408  *
1409  *----------------------------------------------------------------------
1410  */
1411
1412 static void
1413 DestroyMenuEntry(memPtr)
1414     char *memPtr;               /* Pointer to entry to be freed. */
1415 {
1416     register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr;
1417     TkMenu *menuPtr = mePtr->menuPtr;
1418
1419     if (menuPtr->postedCascade == mePtr) {
1420
1421         /*
1422          * Ignore errors while unposting the menu, since it's possible
1423          * that the menu has already been deleted and the unpost will
1424          * generate an error.
1425          */
1426
1427         TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL);
1428     }
1429
1430     /*
1431      * Free up all the stuff that requires special handling, then
1432      * let Tk_FreeConfigOptions handle all the standard option-related
1433      * stuff.
1434      */
1435
1436     if (mePtr->type == CASCADE_ENTRY) {
1437         UnhookCascadeEntry(mePtr);
1438     }
1439     if (mePtr->image != NULL) {
1440         Tk_FreeImage(mePtr->image);
1441     }
1442     if (mePtr->selectImage != NULL) {
1443         Tk_FreeImage(mePtr->selectImage);
1444     }
1445     if (((mePtr->type == CHECK_BUTTON_ENTRY)
1446             || (mePtr->type == RADIO_BUTTON_ENTRY))
1447             && (mePtr->namePtr != NULL)) {
1448         char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
1449         Tcl_UntraceVar(menuPtr->interp, varName,
1450                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1451                 MenuVarProc, (ClientData) mePtr);
1452     }
1453     TkpDestroyMenuEntry(mePtr);
1454     TkMenuEntryFreeDrawOptions(mePtr);
1455     Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
1456     ckfree((char *) mePtr);
1457 }
1458 \f
1459 /*
1460  *---------------------------------------------------------------------------
1461  *
1462  * MenuWorldChanged --
1463  *
1464  *      This procedure is called when the world has changed in some
1465  *      way (such as the fonts in the system changing) and the widget needs
1466  *      to recompute all its graphics contexts and determine its new geometry.
1467  *
1468  * Results:
1469  *      None.
1470  *
1471  * Side effects:
1472  *      Menu will be relayed out and redisplayed.
1473  *
1474  *---------------------------------------------------------------------------
1475  */
1476
1477 static void
1478 MenuWorldChanged(instanceData)
1479     ClientData instanceData;    /* Information about widget. */
1480 {
1481     TkMenu *menuPtr = (TkMenu *) instanceData;
1482     int i;
1483
1484     TkMenuConfigureDrawOptions(menuPtr);
1485     for (i = 0; i < menuPtr->numEntries; i++) {
1486         TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
1487                 menuPtr->entries[i]->index);
1488         TkpConfigureMenuEntry(menuPtr->entries[i]);
1489     }
1490 }
1491 \f
1492 /*
1493  *----------------------------------------------------------------------
1494  *
1495  * ConfigureMenu --
1496  *
1497  *      This procedure is called to process an argv/argc list, plus
1498  *      the Tk option database, in order to configure (or
1499  *      reconfigure) a menu widget.
1500  *
1501  * Results:
1502  *      The return value is a standard Tcl result.  If TCL_ERROR is
1503  *      returned, then the interp's result contains an error message.
1504  *
1505  * Side effects:
1506  *      Configuration information, such as colors, font, etc. get set
1507  *      for menuPtr;  old resources get freed, if there were any.
1508  *
1509  *----------------------------------------------------------------------
1510  */
1511
1512 static int
1513 ConfigureMenu(interp, menuPtr, objc, objv)
1514     Tcl_Interp *interp;         /* Used for error reporting. */
1515     register TkMenu *menuPtr;   /* Information about widget;  may or may
1516                                  * not already have values for some fields. */
1517     int objc;                   /* Number of valid entries in argv. */
1518     Tcl_Obj *CONST objv[];      /* Arguments. */
1519 {
1520     int i;
1521     TkMenu *menuListPtr, *cleanupPtr;
1522     int result;
1523
1524     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
1525             menuListPtr = menuListPtr->nextInstancePtr) {
1526         menuListPtr->errorStructPtr = (Tk_SavedOptions *)
1527                 ckalloc(sizeof(Tk_SavedOptions));
1528         result = Tk_SetOptions(interp, (char *) menuListPtr,
1529                 menuListPtr->optionTablesPtr->menuOptionTable, objc, objv,
1530                 menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL);
1531         if (result != TCL_OK) {
1532             for (cleanupPtr = menuPtr->masterMenuPtr;
1533                     cleanupPtr != menuListPtr;
1534                     cleanupPtr = cleanupPtr->nextInstancePtr) {
1535                 Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
1536                 ckfree((char *) cleanupPtr->errorStructPtr);
1537                 cleanupPtr->errorStructPtr = NULL;
1538             }
1539             if (menuListPtr->errorStructPtr != NULL) {
1540                 Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
1541                 ckfree((char *) menuListPtr->errorStructPtr);
1542                 menuListPtr->errorStructPtr = NULL;
1543             }
1544             return TCL_ERROR;
1545         }
1546
1547         /*
1548          * When a menu is created, the type is in all of the arguments
1549          * to the menu command. Let Tk_ConfigureWidget take care of
1550          * parsing them, and then set the type after we can look at
1551          * the type string. Once set, a menu's type cannot be changed
1552          */
1553
1554         if (menuListPtr->menuType == UNKNOWN_TYPE) {
1555             Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr,
1556                     menuTypeStrings, NULL, 0, &menuListPtr->menuType);
1557
1558             /*
1559              * Configure the new window to be either a pop-up menu
1560              * or a tear-off menu.
1561              * We don't do this for menubars since they are not toplevel
1562              * windows. Also, since this gets called before CloneMenu has
1563              * a chance to set the menuType field, we have to look at the
1564              * menuTypeName field to tell that this is a menu bar.
1565              */
1566
1567             if (menuListPtr->menuType == MASTER_MENU) {
1568                 TkpMakeMenuWindow(menuListPtr->tkwin, 1);
1569             } else if (menuListPtr->menuType == TEAROFF_MENU) {
1570                 TkpMakeMenuWindow(menuListPtr->tkwin, 0);
1571             }
1572         }
1573
1574
1575         /*
1576          * Depending on the -tearOff option, make sure that there is or
1577          * isn't an initial tear-off entry at the beginning of the menu.
1578          */
1579
1580         if (menuListPtr->tearoff) {
1581             if ((menuListPtr->numEntries == 0)
1582                     || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
1583                 if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
1584                     for (cleanupPtr = menuPtr->masterMenuPtr;
1585                          cleanupPtr != menuListPtr;
1586                          cleanupPtr = cleanupPtr->nextInstancePtr) {
1587                         Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
1588                         ckfree((char *) cleanupPtr->errorStructPtr);
1589                         cleanupPtr->errorStructPtr = NULL;
1590                     }
1591                     if (menuListPtr->errorStructPtr != NULL) {
1592                         Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
1593                         ckfree((char *) menuListPtr->errorStructPtr);
1594                         menuListPtr->errorStructPtr = NULL;
1595                     }
1596                     return TCL_ERROR;
1597                 }
1598             }
1599         } else if ((menuListPtr->numEntries > 0)
1600                 && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
1601             int i;
1602
1603             Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
1604                     DestroyMenuEntry);
1605
1606             for (i = 0; i < menuListPtr->numEntries - 1; i++) {
1607                 menuListPtr->entries[i] = menuListPtr->entries[i + 1];
1608                 menuListPtr->entries[i]->index = i;
1609             }
1610             menuListPtr->numEntries--;
1611             if (menuListPtr->numEntries == 0) {
1612                 ckfree((char *) menuListPtr->entries);
1613                 menuListPtr->entries = NULL;
1614             }
1615         }
1616
1617         TkMenuConfigureDrawOptions(menuListPtr);
1618
1619         /*
1620          * After reconfiguring a menu, we need to reconfigure all of the
1621          * entries in the menu, since some of the things in the children
1622          * (such as graphics contexts) may have to change to reflect changes
1623          * in the parent.
1624          */
1625
1626         for (i = 0; i < menuListPtr->numEntries; i++) {
1627             TkMenuEntry *mePtr;
1628
1629             mePtr = menuListPtr->entries[i];
1630             ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL);
1631         }
1632
1633         TkEventuallyRecomputeMenu(menuListPtr);
1634     }
1635
1636     for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL;
1637             cleanupPtr = cleanupPtr->nextInstancePtr) {
1638         Tk_FreeSavedOptions(cleanupPtr->errorStructPtr);
1639         ckfree((char *) cleanupPtr->errorStructPtr);
1640         cleanupPtr->errorStructPtr = NULL;
1641     }
1642
1643     return TCL_OK;
1644 }
1645
1646 \f
1647 /*
1648  *----------------------------------------------------------------------
1649  *
1650  * PostProcessEntry --
1651  *
1652  *      This is called by ConfigureMenuEntry to do all of the configuration
1653  *      after Tk_SetOptions is called. This is separate
1654  *      so that error handling is easier.
1655  *
1656  * Results:
1657  *      The return value is a standard Tcl result.  If TCL_ERROR is
1658  *      returned, then the interp's result contains an error message.
1659  *
1660  * Side effects:
1661  *      Configuration information such as label and accelerator get
1662  *      set for mePtr;  old resources get freed, if there were any.
1663  *
1664  *----------------------------------------------------------------------
1665  */
1666
1667 static int
1668 PostProcessEntry(mePtr)
1669     TkMenuEntry *mePtr;                 /* The entry we are configuring. */
1670 {
1671     TkMenu *menuPtr = mePtr->menuPtr;
1672     int index = mePtr->index;
1673     char *name;
1674     Tk_Image image;
1675
1676     /*
1677      * The code below handles special configuration stuff not taken
1678      * care of by Tk_ConfigureWidget, such as special processing for
1679      * defaults, sizing strings, graphics contexts, etc.
1680      */
1681
1682     if (mePtr->labelPtr == NULL) {
1683         mePtr->labelLength = 0;
1684     } else {
1685         Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
1686     }
1687     if (mePtr->accelPtr == NULL) {
1688         mePtr->accelLength = 0;
1689     } else {
1690         Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
1691     }
1692
1693     /*
1694      * If this is a cascade entry, the platform-specific data of the child
1695      * menu has to be updated. Also, the links that point to parents and
1696      * cascades have to be updated.
1697      */
1698
1699     if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
1700         TkMenuEntry *cascadeEntryPtr;
1701         int alreadyThere;
1702         TkMenuReferences *menuRefPtr;
1703         char *oldHashKey = NULL;        /* Initialization only needed to
1704                                          * prevent compiler warning. */
1705
1706         /*
1707          * This is a cascade entry. If the menu that the cascade entry
1708          * is pointing to has changed, we need to remove this entry
1709          * from the list of entries pointing to the old menu, and add a
1710          * cascade reference to the list of entries pointing to the
1711          * new menu.
1712          *
1713          * BUG: We are not recloning for special case #3 yet.
1714          */
1715
1716         name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
1717         if (mePtr->childMenuRefPtr != NULL) {
1718             oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
1719                     mePtr->childMenuRefPtr->hashEntryPtr);
1720             if (strcmp(oldHashKey, name) != 0) {
1721                 UnhookCascadeEntry(mePtr);
1722             }
1723         }
1724
1725         if ((mePtr->childMenuRefPtr == NULL)
1726                 || (strcmp(oldHashKey, name) != 0)) {
1727             menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);
1728             mePtr->childMenuRefPtr = menuRefPtr;
1729
1730             if (menuRefPtr->parentEntryPtr == NULL) {
1731                 menuRefPtr->parentEntryPtr = mePtr;
1732             } else {
1733                 alreadyThere = 0;
1734                 for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
1735                         cascadeEntryPtr != NULL;
1736                         cascadeEntryPtr =
1737                         cascadeEntryPtr->nextCascadePtr) {
1738                     if (cascadeEntryPtr == mePtr) {
1739                         alreadyThere = 1;
1740                         break;
1741                     }
1742                 }
1743
1744                 /*
1745                  * Put the item at the front of the list.
1746                  */
1747
1748                 if (!alreadyThere) {
1749                     mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr;
1750                     menuRefPtr->parentEntryPtr = mePtr;
1751                 }
1752             }
1753         }
1754     }
1755
1756     if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) {
1757         return TCL_ERROR;
1758     }
1759
1760     if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
1761         return TCL_ERROR;
1762     }
1763
1764     /*
1765      * Get the images for the entry, if there are any.  Allocate the
1766      * new images before freeing the old ones, so that the reference
1767      * counts don't go to zero and cause image data to be discarded.
1768      */
1769
1770     if (mePtr->imagePtr != NULL) {
1771         char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL);
1772         image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString,
1773                 TkMenuImageProc, (ClientData) mePtr);
1774         if (image == NULL) {
1775             return TCL_ERROR;
1776         }
1777     } else {
1778         image = NULL;
1779     }
1780     if (mePtr->image != NULL) {
1781         Tk_FreeImage(mePtr->image);
1782     }
1783     mePtr->image = image;
1784     if (mePtr->selectImagePtr != NULL) {
1785         char *selectImageString = Tcl_GetStringFromObj(
1786                 mePtr->selectImagePtr, NULL);
1787         image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString,
1788                 TkMenuSelectImageProc, (ClientData) mePtr);
1789         if (image == NULL) {
1790             return TCL_ERROR;
1791         }
1792     } else {
1793         image = NULL;
1794     }
1795     if (mePtr->selectImage != NULL) {
1796         Tk_FreeImage(mePtr->selectImage);
1797     }
1798     mePtr->selectImage = image;
1799
1800     if ((mePtr->type == CHECK_BUTTON_ENTRY)
1801             || (mePtr->type == RADIO_BUTTON_ENTRY)) {
1802         Tcl_Obj *valuePtr;
1803         char *name;
1804
1805         if (mePtr->namePtr == NULL) {
1806             if (mePtr->labelPtr == NULL) {
1807                 mePtr->namePtr = NULL;
1808             } else {
1809                 mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr);
1810                 Tcl_IncrRefCount(mePtr->namePtr);
1811             }
1812         }
1813         if (mePtr->onValuePtr == NULL) {
1814             if (mePtr->labelPtr == NULL) {
1815                 mePtr->onValuePtr = NULL;
1816             } else {
1817                 mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr);
1818                 Tcl_IncrRefCount(mePtr->onValuePtr);
1819             }
1820         }
1821
1822         /*
1823          * Select the entry if the associated variable has the
1824          * appropriate value, initialize the variable if it doesn't
1825          * exist, then set a trace on the variable to monitor future
1826          * changes to its value.
1827          */
1828
1829         if (mePtr->namePtr != NULL) {
1830             valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL,
1831                     TCL_GLOBAL_ONLY);
1832         } else {
1833             valuePtr = NULL;
1834         }
1835         mePtr->entryFlags &= ~ENTRY_SELECTED;
1836         if (valuePtr != NULL) {
1837             if (mePtr->onValuePtr != NULL) {
1838                 char *value = Tcl_GetStringFromObj(valuePtr, NULL);
1839                 char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr,
1840                         NULL);
1841
1842
1843                 if (strcmp(value, onValue) == 0) {
1844                     mePtr->entryFlags |= ENTRY_SELECTED;
1845                 }
1846             }
1847         } else {
1848             if (mePtr->namePtr != NULL) {
1849                 Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL,
1850                         (mePtr->type == CHECK_BUTTON_ENTRY)
1851                         ? mePtr->offValuePtr
1852                         : Tcl_NewObj(),
1853                         TCL_GLOBAL_ONLY);
1854             }
1855         }
1856         if (mePtr->namePtr != NULL) {
1857             name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
1858             Tcl_TraceVar(menuPtr->interp, name,
1859                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1860                     MenuVarProc, (ClientData) mePtr);
1861         }
1862     }
1863
1864     return TCL_OK;
1865 }
1866 \f
1867 /*
1868  *----------------------------------------------------------------------
1869  *
1870  * ConfigureMenuEntry --
1871  *
1872  *      This procedure is called to process an argv/argc list in order
1873  *      to configure (or reconfigure) one entry in a menu.
1874  *
1875  * Results:
1876  *      The return value is a standard Tcl result.  If TCL_ERROR is
1877  *      returned, then the interp's result contains an error message.
1878  *
1879  * Side effects:
1880  *      Configuration information such as label and accelerator get
1881  *      set for mePtr;  old resources get freed, if there were any.
1882  *
1883  *----------------------------------------------------------------------
1884  */
1885
1886 static int
1887 ConfigureMenuEntry(mePtr, objc, objv)
1888     register TkMenuEntry *mePtr;        /* Information about menu entry;  may
1889                                          * or may not already have values for
1890                                          * some fields. */
1891     int objc;                           /* Number of valid entries in argv. */
1892     Tcl_Obj *CONST objv[];              /* Arguments. */
1893 {
1894     TkMenu *menuPtr = mePtr->menuPtr;
1895     Tk_SavedOptions errorStruct;
1896     int result;
1897
1898     /*
1899      * If this entry is a check button or radio button, then remove
1900      * its old trace procedure.
1901      */
1902
1903     if ((mePtr->namePtr != NULL)
1904             && ((mePtr->type == CHECK_BUTTON_ENTRY)
1905             || (mePtr->type == RADIO_BUTTON_ENTRY))) {
1906         char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
1907         Tcl_UntraceVar(menuPtr->interp, name,
1908                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1909                 MenuVarProc, (ClientData) mePtr);
1910     }
1911
1912     result = TCL_OK;
1913     if (menuPtr->tkwin != NULL) {
1914         if (Tk_SetOptions(menuPtr->interp, (char *) mePtr,
1915                 mePtr->optionTable, objc, objv, menuPtr->tkwin,
1916                 &errorStruct, (int *) NULL) != TCL_OK) {
1917             return TCL_ERROR;
1918         }
1919         result = PostProcessEntry(mePtr);
1920         if (result != TCL_OK) {
1921             Tk_RestoreSavedOptions(&errorStruct);
1922             PostProcessEntry(mePtr);
1923         }
1924         Tk_FreeSavedOptions(&errorStruct);
1925     }
1926
1927     TkEventuallyRecomputeMenu(menuPtr);
1928
1929     return result;
1930 }
1931 \f
1932 /*
1933  *----------------------------------------------------------------------
1934  *
1935  * ConfigureMenuCloneEntries --
1936  *
1937  *      Calls ConfigureMenuEntry for each menu in the clone chain.
1938  *
1939  * Results:
1940  *      The return value is a standard Tcl result.  If TCL_ERROR is
1941  *      returned, then the interp's result contains an error message.
1942  *
1943  * Side effects:
1944  *      Configuration information such as label and accelerator get
1945  *      set for mePtr;  old resources get freed, if there were any.
1946  *
1947  *----------------------------------------------------------------------
1948  */
1949
1950 static int
1951 ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv)
1952     Tcl_Interp *interp;                 /* Used for error reporting. */
1953     TkMenu *menuPtr;                    /* Information about whole menu. */
1954     int index;                          /* Index of mePtr within menuPtr's
1955                                          * entries. */
1956     int objc;                           /* Number of valid entries in argv. */
1957     Tcl_Obj *CONST objv[];              /* Arguments. */
1958 {
1959     TkMenuEntry *mePtr;
1960     TkMenu *menuListPtr;
1961     int cascadeEntryChanged = 0;
1962     TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL;
1963     Tcl_Obj *oldCascadePtr = NULL;
1964     char *newCascadeName;
1965
1966     /*
1967      * Cascades are kind of tricky here. This is special case #3 in the comment
1968      * at the top of this file. Basically, if a menu is the master menu of a
1969      * clone chain, and has an entry with a cascade menu, the clones of
1970      * the menu will point to clones of the cascade menu. We have
1971      * to destroy the clones of the cascades, clone the new cascade
1972      * menu, and configure the entry to point to the new clone.
1973      */
1974
1975     mePtr = menuPtr->masterMenuPtr->entries[index];
1976     if (mePtr->type == CASCADE_ENTRY) {
1977         oldCascadePtr = mePtr->namePtr;
1978         if (oldCascadePtr != NULL) {
1979             Tcl_IncrRefCount(oldCascadePtr);
1980         }
1981     }
1982
1983     if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
1984         return TCL_ERROR;
1985     }
1986
1987     if (mePtr->type == CASCADE_ENTRY) {
1988         char *oldCascadeName;
1989
1990         if (mePtr->namePtr != NULL) {
1991             newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
1992         } else {
1993             newCascadeName = NULL;
1994         }
1995
1996         if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) {
1997             cascadeEntryChanged = 0;
1998         } else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL))
1999                 || ((oldCascadePtr != NULL)
2000                 && (mePtr->namePtr == NULL))) {
2001             cascadeEntryChanged = 1;
2002         } else {
2003             oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr,
2004                     NULL);
2005             cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName)
2006                     != 0);
2007         }
2008         if (oldCascadePtr != NULL) {
2009             Tcl_DecrRefCount(oldCascadePtr);
2010         }
2011     }
2012
2013     if (cascadeEntryChanged) {
2014         if (mePtr->namePtr != NULL) {
2015             newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
2016             cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
2017                     newCascadeName);
2018         }
2019     }
2020
2021     for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr;
2022             menuListPtr != NULL;
2023             menuListPtr = menuListPtr->nextInstancePtr) {
2024
2025         mePtr = menuListPtr->entries[index];
2026
2027         if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
2028             oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
2029                     mePtr->namePtr);
2030
2031             if ((oldCascadeMenuRefPtr != NULL)
2032                     && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
2033                 RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
2034             }
2035         }
2036
2037         if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
2038             return TCL_ERROR;
2039         }
2040
2041         if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
2042             if (cascadeMenuRefPtr->menuPtr != NULL) {
2043                 Tcl_Obj *newObjv[2];
2044                 Tcl_Obj *newCloneNamePtr;
2045                 Tcl_Obj *pathNamePtr = Tcl_NewStringObj(
2046                         Tk_PathName(menuListPtr->tkwin), -1);
2047                 Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
2048                 Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1);
2049
2050                 Tcl_IncrRefCount(pathNamePtr);
2051                 newCloneNamePtr = TkNewMenuName(menuPtr->interp,
2052                         pathNamePtr,
2053                         cascadeMenuRefPtr->menuPtr);
2054                 Tcl_IncrRefCount(newCloneNamePtr);
2055                 Tcl_IncrRefCount(normalPtr);
2056                 CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr,
2057                         normalPtr);
2058
2059                 newObjv[0] = menuObjPtr;
2060                 newObjv[1] = newCloneNamePtr;
2061                 Tcl_IncrRefCount(menuObjPtr);
2062                 ConfigureMenuEntry(mePtr, 2, newObjv);
2063                 Tcl_DecrRefCount(newCloneNamePtr);
2064                 Tcl_DecrRefCount(pathNamePtr);
2065                 Tcl_DecrRefCount(normalPtr);
2066                 Tcl_DecrRefCount(menuObjPtr);
2067             }
2068         }
2069     }
2070     return TCL_OK;
2071 }
2072 \f
2073 /*
2074  *--------------------------------------------------------------
2075  *
2076  * TkGetMenuIndex --
2077  *
2078  *      Parse a textual index into a menu and return the numerical
2079  *      index of the indicated entry.
2080  *
2081  * Results:
2082  *      A standard Tcl result.  If all went well, then *indexPtr is
2083  *      filled in with the entry index corresponding to string
2084  *      (ranges from -1 to the number of entries in the menu minus
2085  *      one).  Otherwise an error message is left in the interp's result.
2086  *
2087  * Side effects:
2088  *      None.
2089  *
2090  *--------------------------------------------------------------
2091  */
2092
2093 int
2094 TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr)
2095     Tcl_Interp *interp;         /* For error messages. */
2096     TkMenu *menuPtr;            /* Menu for which the index is being
2097                                  * specified. */
2098     Tcl_Obj *objPtr;            /* Specification of an entry in menu.  See
2099                                  * manual entry for valid .*/
2100     int lastOK;                 /* Non-zero means its OK to return index
2101                                  * just *after* last entry. */
2102     int *indexPtr;              /* Where to store converted index. */
2103 {
2104     int i;
2105     char *string = Tcl_GetStringFromObj(objPtr, NULL);
2106
2107     if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
2108         *indexPtr = menuPtr->active;
2109         goto success;
2110     }
2111
2112     if (((string[0] == 'l') && (strcmp(string, "last") == 0))
2113             || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
2114         *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
2115         goto success;
2116     }
2117
2118     if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
2119         *indexPtr = -1;
2120         goto success;
2121     }
2122
2123     if (string[0] == '@') {
2124         if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
2125                 == TCL_OK) {
2126             goto success;
2127         }
2128     }
2129
2130     if (isdigit(UCHAR(string[0]))) {
2131         if (Tcl_GetInt(interp, string,  &i) == TCL_OK) {
2132             if (i >= menuPtr->numEntries) {
2133                 if (lastOK) {
2134                     i = menuPtr->numEntries;
2135                 } else {
2136                     i = menuPtr->numEntries-1;
2137                 }
2138             } else if (i < 0) {
2139                 i = -1;
2140             }
2141             *indexPtr = i;
2142             goto success;
2143         }
2144         Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
2145     }
2146
2147     for (i = 0; i < menuPtr->numEntries; i++) {
2148         Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
2149         char *label = (labelPtr == NULL) ? NULL
2150                 : Tcl_GetStringFromObj(labelPtr, NULL);
2151
2152         if ((label != NULL)
2153                 && (Tcl_StringMatch(label, string))) {
2154             *indexPtr = i;
2155             goto success;
2156         }
2157     }
2158
2159     Tcl_AppendResult(interp, "bad menu entry index \"",
2160             string, "\"", (char *) NULL);
2161     return TCL_ERROR;
2162
2163 success:
2164     return TCL_OK;
2165 }
2166 \f
2167 /*
2168  *----------------------------------------------------------------------
2169  *
2170  * MenuCmdDeletedProc --
2171  *
2172  *      This procedure is invoked when a widget command is deleted.  If
2173  *      the widget isn't already in the process of being destroyed,
2174  *      this command destroys it.
2175  *
2176  * Results:
2177  *      None.
2178  *
2179  * Side effects:
2180  *      The widget is destroyed.
2181  *
2182  *----------------------------------------------------------------------
2183  */
2184
2185 static void
2186 MenuCmdDeletedProc(clientData)
2187     ClientData clientData;      /* Pointer to widget record for widget. */
2188 {
2189     TkMenu *menuPtr = (TkMenu *) clientData;
2190     Tk_Window tkwin = menuPtr->tkwin;
2191
2192     /*
2193      * This procedure could be invoked either because the window was
2194      * destroyed and the command was then deleted (in which case tkwin
2195      * is NULL) or because the command was deleted, and then this procedure
2196      * destroys the widget.
2197      */
2198
2199     if (tkwin != NULL) {
2200         Tk_DestroyWindow(tkwin);
2201     }
2202 }
2203 \f
2204 /*
2205  *----------------------------------------------------------------------
2206  *
2207  * MenuNewEntry --
2208  *
2209  *      This procedure allocates and initializes a new menu entry.
2210  *
2211  * Results:
2212  *      The return value is a pointer to a new menu entry structure,
2213  *      which has been malloc-ed, initialized, and entered into the
2214  *      entry array for the  menu.
2215  *
2216  * Side effects:
2217  *      Storage gets allocated.
2218  *
2219  *----------------------------------------------------------------------
2220  */
2221
2222 static TkMenuEntry *
2223 MenuNewEntry(menuPtr, index, type)
2224     TkMenu *menuPtr;            /* Menu that will hold the new entry. */
2225     int index;                  /* Where in the menu the new entry is to
2226                                  * go. */
2227     int type;                   /* The type of the new entry. */
2228 {
2229     TkMenuEntry *mePtr;
2230     TkMenuEntry **newEntries;
2231     int i;
2232
2233     /*
2234      * Create a new array of entries with an empty slot for the
2235      * new entry.
2236      */
2237
2238     newEntries = (TkMenuEntry **) ckalloc((unsigned)
2239             ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *)));
2240     for (i = 0; i < index; i++) {
2241         newEntries[i] = menuPtr->entries[i];
2242     }
2243     for (  ; i < menuPtr->numEntries; i++) {
2244         newEntries[i+1] = menuPtr->entries[i];
2245         newEntries[i+1]->index = i + 1;
2246     }
2247     if (menuPtr->numEntries != 0) {
2248         ckfree((char *) menuPtr->entries);
2249     }
2250     menuPtr->entries = newEntries;
2251     menuPtr->numEntries++;
2252     mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
2253     menuPtr->entries[index] = mePtr;
2254     mePtr->type = type;
2255     mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type];
2256     mePtr->menuPtr = menuPtr;
2257     mePtr->labelPtr = NULL;
2258     mePtr->labelLength = 0;
2259     mePtr->underline = -1;
2260     mePtr->bitmapPtr = NULL;
2261     mePtr->imagePtr = NULL;
2262     mePtr->image = NULL;
2263     mePtr->selectImagePtr = NULL;
2264     mePtr->selectImage = NULL;
2265     mePtr->accelPtr = NULL;
2266     mePtr->accelLength = 0;
2267     mePtr->state = ENTRY_DISABLED;
2268     mePtr->borderPtr = NULL;
2269     mePtr->fgPtr = NULL;
2270     mePtr->activeBorderPtr = NULL;
2271     mePtr->activeFgPtr = NULL;
2272     mePtr->fontPtr = NULL;
2273     mePtr->indicatorOn = 0;
2274     mePtr->indicatorFgPtr = NULL;
2275     mePtr->columnBreak = 0;
2276     mePtr->hideMargin = 0;
2277     mePtr->commandPtr = NULL;
2278     mePtr->namePtr = NULL;
2279     mePtr->childMenuRefPtr = NULL;
2280     mePtr->onValuePtr = NULL;
2281     mePtr->offValuePtr = NULL;
2282     mePtr->entryFlags = 0;
2283     mePtr->index = index;
2284     mePtr->nextCascadePtr = NULL;
2285     if (Tk_InitOptions(menuPtr->interp, (char *) mePtr,
2286             mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
2287         ckfree((char *) mePtr);
2288         return NULL;
2289     }
2290     TkMenuInitializeEntryDrawingFields(mePtr);
2291     if (TkpMenuNewEntry(mePtr) != TCL_OK) {
2292         Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
2293                 menuPtr->tkwin);
2294         ckfree((char *) mePtr);
2295         return NULL;
2296     }
2297
2298     return mePtr;
2299 }
2300 \f
2301 /*
2302  *----------------------------------------------------------------------
2303  *
2304  * MenuAddOrInsert --
2305  *
2306  *      This procedure does all of the work of the "add" and "insert"
2307  *      widget commands, allowing the code for these to be shared.
2308  *
2309  * Results:
2310  *      A standard Tcl return value.
2311  *
2312  * Side effects:
2313  *      A new menu entry is created in menuPtr.
2314  *
2315  *----------------------------------------------------------------------
2316  */
2317
2318 static int
2319 MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv)
2320     Tcl_Interp *interp;                 /* Used for error reporting. */
2321     TkMenu *menuPtr;                    /* Widget in which to create new
2322                                          * entry. */
2323     Tcl_Obj *indexPtr;                  /* Object describing index at which
2324                                          * to insert.  NULL means insert at
2325                                          * end. */
2326     int objc;                           /* Number of elements in objv. */
2327     Tcl_Obj *CONST objv[];              /* Arguments to command:  first arg
2328                                          * is type of entry, others are
2329                                          * config options. */
2330 {
2331     int type, index;
2332     TkMenuEntry *mePtr;
2333     TkMenu *menuListPtr;
2334
2335     if (indexPtr != NULL) {
2336         if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index)
2337                 != TCL_OK) {
2338             return TCL_ERROR;
2339         }
2340     } else {
2341         index = menuPtr->numEntries;
2342     }
2343     if (index < 0) {
2344         char *indexString = Tcl_GetStringFromObj(indexPtr, NULL);
2345         Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
2346                  (char *) NULL);
2347         return TCL_ERROR;
2348     }
2349     if (menuPtr->tearoff && (index == 0)) {
2350         index = 1;
2351     }
2352
2353     /*
2354      * Figure out the type of the new entry.
2355      */
2356
2357     if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings,
2358             "menu entry type", 0, &type) != TCL_OK) {
2359         return TCL_ERROR;
2360     }
2361
2362     /*
2363      * Now we have to add an entry for every instance related to this menu.
2364      */
2365
2366     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
2367             menuListPtr = menuListPtr->nextInstancePtr) {
2368
2369         mePtr = MenuNewEntry(menuListPtr, index, type);
2370         if (mePtr == NULL) {
2371             return TCL_ERROR;
2372         }
2373         if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
2374             TkMenu *errorMenuPtr;
2375             int i;
2376
2377             for (errorMenuPtr = menuPtr->masterMenuPtr;
2378                     errorMenuPtr != NULL;
2379                     errorMenuPtr = errorMenuPtr->nextInstancePtr) {
2380                 Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index],
2381                         DestroyMenuEntry);
2382                 for (i = index; i < errorMenuPtr->numEntries - 1; i++) {
2383                     errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1];
2384                     errorMenuPtr->entries[i]->index = i;
2385                 }
2386                 errorMenuPtr->numEntries--;
2387                 if (errorMenuPtr->numEntries == 0) {
2388                     ckfree((char *) errorMenuPtr->entries);
2389                     errorMenuPtr->entries = NULL;
2390                 }
2391                 if (errorMenuPtr == menuListPtr) {
2392                     break;
2393                 }
2394             }
2395             return TCL_ERROR;
2396         }
2397
2398         /*
2399          * If a menu has cascades, then every instance of the menu has
2400          * to have its own parallel cascade structure. So adding an
2401          * entry to a menu with clones means that the menu that the
2402          * entry points to has to be cloned for every clone the
2403          * master menu has. This is special case #2 in the comment
2404          * at the top of this file.
2405          */
2406
2407         if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {
2408             if ((mePtr->namePtr != NULL)
2409                     && (mePtr->childMenuRefPtr != NULL)
2410                     && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
2411                 TkMenu *cascadeMenuPtr =
2412                         mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
2413                 Tcl_Obj *newCascadePtr;
2414                 Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
2415                 Tcl_Obj *windowNamePtr =
2416                         Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1);
2417                 Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
2418                 Tcl_Obj *newObjv[2];
2419                 TkMenuReferences *menuRefPtr;
2420
2421                 Tcl_IncrRefCount(windowNamePtr);
2422                 newCascadePtr = TkNewMenuName(menuListPtr->interp,
2423                         windowNamePtr, cascadeMenuPtr);
2424                 Tcl_IncrRefCount(newCascadePtr);
2425                 Tcl_IncrRefCount(normalPtr);
2426                 CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
2427
2428                 menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
2429                         newCascadePtr);
2430                 if (menuRefPtr == NULL) {
2431                     panic("CloneMenu failed inside of MenuAddOrInsert.");
2432                 }
2433                 newObjv[0] = menuNamePtr;
2434                 newObjv[1] = newCascadePtr;
2435                 Tcl_IncrRefCount(menuNamePtr);
2436                 Tcl_IncrRefCount(newCascadePtr);
2437                 ConfigureMenuEntry(mePtr, 2, newObjv);
2438                 Tcl_DecrRefCount(newCascadePtr);
2439                 Tcl_DecrRefCount(menuNamePtr);
2440                 Tcl_DecrRefCount(windowNamePtr);
2441                 Tcl_DecrRefCount(normalPtr);
2442             }
2443         }
2444     }
2445     return TCL_OK;
2446 }
2447 \f
2448 /*
2449  *--------------------------------------------------------------
2450  *
2451  * MenuVarProc --
2452  *
2453  *      This procedure is invoked when someone changes the
2454  *      state variable associated with a radiobutton or checkbutton
2455  *      menu entry.  The entry's selected state is set to match
2456  *      the value of the variable.
2457  *
2458  * Results:
2459  *      NULL is always returned.
2460  *
2461  * Side effects:
2462  *      The menu entry may become selected or deselected.
2463  *
2464  *--------------------------------------------------------------
2465  */
2466
2467 static char *
2468 MenuVarProc(clientData, interp, name1, name2, flags)
2469     ClientData clientData;      /* Information about menu entry. */
2470     Tcl_Interp *interp;         /* Interpreter containing variable. */
2471     CONST char *name1;          /* First part of variable's name. */
2472     CONST char *name2;          /* Second part of variable's name. */
2473     int flags;                  /* Describes what just happened. */
2474 {
2475     TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
2476     TkMenu *menuPtr;
2477     CONST char *value;
2478     char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
2479     char *onValue;
2480
2481     menuPtr = mePtr->menuPtr;
2482
2483     /*
2484      * If the variable is being unset, then re-establish the
2485      * trace unless the whole interpreter is going away.
2486      */
2487
2488     if (flags & TCL_TRACE_UNSETS) {
2489         mePtr->entryFlags &= ~ENTRY_SELECTED;
2490         if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
2491             Tcl_TraceVar(interp, name,
2492                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
2493                     MenuVarProc, clientData);
2494         }
2495         TkpConfigureMenuEntry(mePtr);
2496         TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
2497         return (char *) NULL;
2498     }
2499
2500     /*
2501      * Use the value of the variable to update the selected status of
2502      * the menu entry.
2503      */
2504
2505     value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY);
2506     if (value == NULL) {
2507         value = "";
2508     }
2509     if (mePtr->onValuePtr != NULL) {
2510         onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL);
2511         if (strcmp(value, onValue) == 0) {
2512             if (mePtr->entryFlags & ENTRY_SELECTED) {
2513                 return (char *) NULL;
2514             }
2515             mePtr->entryFlags |= ENTRY_SELECTED;
2516         } else if (mePtr->entryFlags & ENTRY_SELECTED) {
2517             mePtr->entryFlags &= ~ENTRY_SELECTED;
2518         } else {
2519             return (char *) NULL;
2520         }
2521     } else {
2522         return (char *) NULL;
2523     }
2524     TkpConfigureMenuEntry(mePtr);
2525     TkEventuallyRedrawMenu(menuPtr, mePtr);
2526     return (char *) NULL;
2527 }
2528 \f
2529 /*
2530  *----------------------------------------------------------------------
2531  *
2532  * TkActivateMenuEntry --
2533  *
2534  *      This procedure is invoked to make a particular menu entry
2535  *      the active one, deactivating any other entry that might
2536  *      currently be active.
2537  *
2538  * Results:
2539  *      The return value is a standard Tcl result (errors can occur
2540  *      while posting and unposting submenus).
2541  *
2542  * Side effects:
2543  *      Menu entries get redisplayed, and the active entry changes.
2544  *      Submenus may get posted and unposted.
2545  *
2546  *----------------------------------------------------------------------
2547  */
2548
2549 int
2550 TkActivateMenuEntry(menuPtr, index)
2551     register TkMenu *menuPtr;           /* Menu in which to activate. */
2552     int index;                          /* Index of entry to activate, or
2553                                          * -1 to deactivate all entries. */
2554 {
2555     register TkMenuEntry *mePtr;
2556     int result = TCL_OK;
2557
2558     if (menuPtr->active >= 0) {
2559         mePtr = menuPtr->entries[menuPtr->active];
2560
2561         /*
2562          * Don't change the state unless it's currently active (state
2563          * might already have been changed to disabled).
2564          */
2565
2566         if (mePtr->state == ENTRY_ACTIVE) {
2567             mePtr->state = ENTRY_NORMAL;
2568         }
2569         TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
2570     }
2571     menuPtr->active = index;
2572     if (index >= 0) {
2573         mePtr = menuPtr->entries[index];
2574         mePtr->state = ENTRY_ACTIVE;
2575         TkEventuallyRedrawMenu(menuPtr, mePtr);
2576     }
2577     return result;
2578 }
2579 \f
2580 /*
2581  *----------------------------------------------------------------------
2582  *
2583  * TkPostCommand --
2584  *
2585  *      Execute the postcommand for the given menu.
2586  *
2587  * Results:
2588  *      The return value is a standard Tcl result (errors can occur
2589  *      while the postcommands are being processed).
2590  *
2591  * Side effects:
2592  *      Since commands can get executed while this routine is being executed,
2593  *      the entire world can change.
2594  *
2595  *----------------------------------------------------------------------
2596  */
2597
2598 int
2599 TkPostCommand(menuPtr)
2600     TkMenu *menuPtr;
2601 {
2602     int result;
2603
2604     /*
2605      * If there is a command for the menu, execute it.  This
2606      * may change the size of the menu, so be sure to recompute
2607      * the menu's geometry if needed.
2608      */
2609
2610     if (menuPtr->postCommandPtr != NULL) {
2611         Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr;
2612
2613         Tcl_IncrRefCount(postCommandPtr);
2614         result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr,
2615                 TCL_EVAL_GLOBAL);
2616         Tcl_DecrRefCount(postCommandPtr);
2617         if (result != TCL_OK) {
2618             return result;
2619         }
2620         TkRecomputeMenu(menuPtr);
2621     }
2622     return TCL_OK;
2623 }
2624 \f
2625 /*
2626  *--------------------------------------------------------------
2627  *
2628  * CloneMenu --
2629  *
2630  *      Creates a child copy of the menu. It will be inserted into
2631  *      the menu's instance chain. All attributes and entry
2632  *      attributes will be duplicated.
2633  *
2634  * Results:
2635  *      A standard Tcl result.
2636  *
2637  * Side effects:
2638  *      Allocates storage. After the menu is created, any
2639  *      configuration done with this menu or any related one
2640  *      will be reflected in all of them.
2641  *
2642  *--------------------------------------------------------------
2643  */
2644
2645 static int
2646 CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr)
2647     TkMenu *menuPtr;            /* The menu we are going to clone */
2648     Tcl_Obj *newMenuNamePtr;    /* The name to give the new menu */
2649     Tcl_Obj *newMenuTypePtr;    /* What kind of menu is this, a normal menu
2650                                  * a menubar, or a tearoff? */
2651 {
2652     int returnResult;
2653     int menuType, i;
2654     TkMenuReferences *menuRefPtr;
2655     Tcl_Obj *menuDupCommandArray[4];
2656
2657     if (newMenuTypePtr == NULL) {
2658         menuType = MASTER_MENU;
2659     } else {
2660         if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr,
2661                 menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) {
2662             return TCL_ERROR;
2663         }
2664     }
2665
2666     menuDupCommandArray[0] = Tcl_NewStringObj("tk::MenuDup", -1);
2667     menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
2668     menuDupCommandArray[2] = newMenuNamePtr;
2669     if (newMenuTypePtr == NULL) {
2670         menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
2671     } else {
2672         menuDupCommandArray[3] = newMenuTypePtr;
2673     }
2674     for (i = 0; i < 4; i++) {
2675         Tcl_IncrRefCount(menuDupCommandArray[i]);
2676     }
2677     Tcl_Preserve((ClientData) menuPtr);
2678     returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0);
2679     for (i = 0; i < 4; i++) {
2680         Tcl_DecrRefCount(menuDupCommandArray[i]);
2681     }
2682
2683     /*
2684      * Make sure the tcl command actually created the clone.
2685      */
2686
2687     if ((returnResult == TCL_OK) &&
2688             ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
2689             newMenuNamePtr)) != (TkMenuReferences *) NULL)
2690             && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
2691         TkMenu *newMenuPtr = menuRefPtr->menuPtr;
2692         Tcl_Obj *newObjv[3];
2693         int i, numElements;
2694
2695         /*
2696          * Now put this newly created menu into the parent menu's instance
2697          * chain.
2698          */
2699
2700         if (menuPtr->nextInstancePtr == NULL) {
2701             menuPtr->nextInstancePtr = newMenuPtr;
2702             newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr;
2703         } else {
2704             TkMenu *masterMenuPtr;
2705
2706             masterMenuPtr = menuPtr->masterMenuPtr;
2707             newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr;
2708             masterMenuPtr->nextInstancePtr = newMenuPtr;
2709             newMenuPtr->masterMenuPtr = masterMenuPtr;
2710         }
2711
2712         /*
2713          * Add the master menu's window to the bind tags for this window
2714          * after this window's tag. This is so the user can bind to either
2715          * this clone (which may not be easy to do) or the entire menu
2716          * clone structure.
2717          */
2718
2719         newObjv[0] = Tcl_NewStringObj("bindtags", -1);
2720         newObjv[1] = Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), -1);
2721         Tcl_IncrRefCount(newObjv[0]);
2722         Tcl_IncrRefCount(newObjv[1]);
2723         if (Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin,
2724                 newMenuPtr->interp, 2, newObjv) == TCL_OK) {
2725             char *windowName;
2726             Tcl_Obj *bindingsPtr =
2727                     Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
2728             Tcl_Obj *elementPtr;
2729
2730             Tcl_IncrRefCount(bindingsPtr);
2731             Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
2732             for (i = 0; i < numElements; i++) {
2733                 Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
2734                         &elementPtr);
2735                 windowName = Tcl_GetStringFromObj(elementPtr, NULL);
2736                 if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
2737                         == 0) {
2738                     Tcl_Obj *newElementPtr = Tcl_NewStringObj(
2739                             Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
2740                     /*
2741                      * The newElementPtr will have its refCount incremented
2742                      * here, so we don't need to worry about it any more.
2743                      */
2744                     Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
2745                             i + 1, 0, 1, &newElementPtr);
2746                     newObjv[2] = bindingsPtr;
2747                     Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin,
2748                             menuPtr->interp, 3, newObjv);
2749                     break;
2750                 }
2751             }
2752             Tcl_DecrRefCount(bindingsPtr);
2753         }
2754         Tcl_DecrRefCount(newObjv[0]);
2755         Tcl_DecrRefCount(newObjv[1]);
2756         Tcl_ResetResult(menuPtr->interp);
2757
2758         /*
2759          * Clone all of the cascade menus that this menu points to.
2760          */
2761
2762         for (i = 0; i < menuPtr->numEntries; i++) {
2763             TkMenuReferences *cascadeRefPtr;
2764             TkMenu *oldCascadePtr;
2765
2766             if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
2767                 && (menuPtr->entries[i]->namePtr != NULL)) {
2768                 cascadeRefPtr =
2769                         TkFindMenuReferencesObj(menuPtr->interp,
2770                         menuPtr->entries[i]->namePtr);
2771                 if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
2772                     Tcl_Obj *windowNamePtr =
2773                             Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
2774                             -1);
2775                     Tcl_Obj *newCascadePtr;
2776
2777                     oldCascadePtr = cascadeRefPtr->menuPtr;
2778
2779                     Tcl_IncrRefCount(windowNamePtr);
2780                     newCascadePtr = TkNewMenuName(menuPtr->interp,
2781                             windowNamePtr, oldCascadePtr);
2782                     Tcl_IncrRefCount(newCascadePtr);
2783                     CloneMenu(oldCascadePtr, newCascadePtr, NULL);
2784
2785                     newObjv[0] = Tcl_NewStringObj("-menu", -1);
2786                     newObjv[1] = newCascadePtr;
2787                     Tcl_IncrRefCount(newObjv[0]);
2788                     ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv);
2789                     Tcl_DecrRefCount(newObjv[0]);
2790                     Tcl_DecrRefCount(newCascadePtr);
2791                     Tcl_DecrRefCount(windowNamePtr);
2792                 }
2793             }
2794         }
2795
2796         returnResult = TCL_OK;
2797     } else {
2798         returnResult = TCL_ERROR;
2799     }
2800     Tcl_Release((ClientData) menuPtr);
2801     return returnResult;
2802 }
2803 \f
2804 /*
2805  *----------------------------------------------------------------------
2806  *
2807  * MenuDoYPosition --
2808  *
2809  *      Given arguments from an option command line, returns the Y position.
2810  *
2811  * Results:
2812  *      Returns TCL_OK or TCL_Error
2813  *
2814  * Side effects:
2815  *      yPosition is set to the Y-position of the menu entry.
2816  *
2817  *----------------------------------------------------------------------
2818  */
2819
2820 static int
2821 MenuDoYPosition(interp, menuPtr, objPtr)
2822     Tcl_Interp *interp;
2823     TkMenu *menuPtr;
2824     Tcl_Obj *objPtr;
2825 {
2826     int index;
2827
2828     TkRecomputeMenu(menuPtr);
2829     if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
2830         goto error;
2831     }
2832     Tcl_ResetResult(interp);
2833     if (index < 0) {
2834         Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
2835     } else {
2836         Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
2837     }
2838
2839     return TCL_OK;
2840
2841 error:
2842     return TCL_ERROR;
2843 }
2844 \f
2845 /*
2846  *----------------------------------------------------------------------
2847  *
2848  * GetIndexFromCoords --
2849  *
2850  *      Given a string of the form "@int", return the menu item corresponding
2851  *      to int.
2852  *
2853  * Results:
2854  *      If int is a valid number, *indexPtr will be the number of the menuentry
2855  *      that is the correct height. If int is invaled, *indexPtr will be
2856  *      unchanged. Returns appropriate Tcl error number.
2857  *
2858  * Side effects:
2859  *      If int is invalid, interp's result will set to NULL.
2860  *
2861  *----------------------------------------------------------------------
2862  */
2863
2864 static int
2865 GetIndexFromCoords(interp, menuPtr, string, indexPtr)
2866     Tcl_Interp *interp;         /* interp of menu */
2867     TkMenu *menuPtr;            /* the menu we are searching */
2868     char *string;               /* The @string we are parsing */
2869     int *indexPtr;              /* The index of the item that matches */
2870 {
2871     int x, y, i;
2872     char *p, *end;
2873
2874     TkRecomputeMenu(menuPtr);
2875     p = string + 1;
2876     y = strtol(p, &end, 0);
2877     if (end == p) {
2878         goto error;
2879     }
2880     if (*end == ',') {
2881         x = y;
2882         p = end + 1;
2883         y = strtol(p, &end, 0);
2884         if (end == p) {
2885             goto error;
2886         }
2887     } else {
2888         Tk_GetPixelsFromObj(interp, menuPtr->tkwin,
2889                 menuPtr->borderWidthPtr, &x);
2890     }
2891
2892     for (i = 0; i < menuPtr->numEntries; i++) {
2893         if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
2894                 && (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
2895                 && (y < (menuPtr->entries[i]->y
2896                 + menuPtr->entries[i]->height))) {
2897             break;
2898         }
2899     }
2900     if (i >= menuPtr->numEntries) {
2901         /* i = menuPtr->numEntries - 1; */
2902         i = -1;
2903     }
2904     *indexPtr = i;
2905     return TCL_OK;
2906
2907     error:
2908     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
2909     return TCL_ERROR;
2910 }
2911 \f
2912 /*
2913  *----------------------------------------------------------------------
2914  *
2915  * RecursivelyDeleteMenu --
2916  *
2917  *      Deletes a menu and any cascades underneath it. Used for deleting
2918  *      instances when a menu is no longer being used as a menubar,
2919  *      for instance.
2920  *
2921  * Results:
2922  *      None.
2923  *
2924  * Side effects:
2925  *      Destroys the menu and all cascade menus underneath it.
2926  *
2927  *----------------------------------------------------------------------
2928  */
2929
2930 static void
2931 RecursivelyDeleteMenu(menuPtr)
2932     TkMenu *menuPtr;            /* The menubar instance we are deleting */
2933 {
2934     int i;
2935     TkMenuEntry *mePtr;
2936
2937     for (i = 0; i < menuPtr->numEntries; i++) {
2938         mePtr = menuPtr->entries[i];
2939         if ((mePtr->type == CASCADE_ENTRY)
2940                 && (mePtr->childMenuRefPtr != NULL)
2941                 && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
2942             RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr);
2943         }
2944     }
2945     Tk_DestroyWindow(menuPtr->tkwin);
2946 }
2947 \f
2948 /*
2949  *----------------------------------------------------------------------
2950  *
2951  * TkNewMenuName --
2952  *
2953  *      Makes a new unique name for a cloned menu. Will be a child
2954  *      of oldName.
2955  *
2956  * Results:
2957  *      Returns a char * which has been allocated; caller must free.
2958  *
2959  * Side effects:
2960  *      Memory is allocated.
2961  *
2962  *----------------------------------------------------------------------
2963  */
2964
2965 Tcl_Obj *
2966 TkNewMenuName(interp, parentPtr, menuPtr)
2967     Tcl_Interp *interp;         /* The interp the new name has to live in.*/
2968     Tcl_Obj *parentPtr;         /* The prefix path of the new name. */
2969     TkMenu *menuPtr;            /* The menu we are cloning. */
2970 {
2971     Tcl_Obj *resultPtr = NULL;  /* Initialization needed only to prevent
2972                                  * compiler warning. */
2973     Tcl_Obj *childPtr;
2974     char *destString;
2975     int i;
2976     int doDot;
2977     Tcl_CmdInfo cmdInfo;
2978     Tcl_HashTable *nameTablePtr = NULL;
2979     TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
2980     char *parentName = Tcl_GetStringFromObj(parentPtr, NULL);
2981
2982     if (winPtr->mainPtr != NULL) {
2983         nameTablePtr = &(winPtr->mainPtr->nameTable);
2984     }
2985
2986     doDot = parentName[strlen(parentName) - 1] != '.';
2987
2988     childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
2989     for (destString = Tcl_GetStringFromObj(childPtr, NULL);
2990             *destString != '\0'; destString++) {
2991         if (*destString == '.') {
2992             *destString = '#';
2993         }
2994     }
2995
2996     for (i = 0; ; i++) {
2997         if (i == 0) {
2998             resultPtr = Tcl_DuplicateObj(parentPtr);
2999             if (doDot) {
3000                 Tcl_AppendToObj(resultPtr, ".", -1);
3001             }
3002             Tcl_AppendObjToObj(resultPtr, childPtr);
3003         } else {
3004             Tcl_Obj *intPtr;
3005
3006             Tcl_DecrRefCount(resultPtr);
3007             resultPtr = Tcl_DuplicateObj(parentPtr);
3008             if (doDot) {
3009                 Tcl_AppendToObj(resultPtr, ".", -1);
3010             }
3011             Tcl_AppendObjToObj(resultPtr, childPtr);
3012             intPtr = Tcl_NewIntObj(i);
3013             Tcl_AppendObjToObj(resultPtr, intPtr);
3014             Tcl_DecrRefCount(intPtr);
3015         }
3016         destString = Tcl_GetStringFromObj(resultPtr, NULL);
3017         if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
3018                 && ((nameTablePtr == NULL)
3019                 || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
3020             break;
3021         }
3022     }
3023     Tcl_DecrRefCount(childPtr);
3024     return resultPtr;
3025 }
3026 \f
3027 /*
3028  *----------------------------------------------------------------------
3029  *
3030  * TkSetWindowMenuBar --
3031  *
3032  *      Associates a menu with a window. Called by ConfigureFrame in
3033  *      in response to a "-menu .foo" configuration option for a top
3034  *      level.
3035  *
3036  * Results:
3037  *      None.
3038  *
3039  * Side effects:
3040  *      The old menu clones for the menubar are thrown away, and a
3041  *      handler is set up to allocate the new ones.
3042  *
3043  *----------------------------------------------------------------------
3044  */
3045 void
3046 TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
3047     Tcl_Interp *interp;         /* The interpreter the toplevel lives in. */
3048     Tk_Window tkwin;            /* The toplevel window */
3049     char *oldMenuName;          /* The name of the menubar previously set in
3050                                  * this toplevel. NULL means no menu was
3051                                  * set previously. */
3052     char *menuName;             /* The name of the new menubar that the
3053                                  * toplevel needs to be set to. NULL means
3054                                  * that their is no menu now. */
3055 {
3056     TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr;
3057     TkMenu *menuPtr;
3058     TkMenuReferences *menuRefPtr;
3059
3060     TkMenuInit();
3061
3062     /*
3063      * Destroy the menubar instances of the old menu. Take this window
3064      * out of the old menu's top level reference list.
3065      */
3066
3067     if (oldMenuName != NULL) {
3068         menuRefPtr = TkFindMenuReferences(interp, oldMenuName);
3069         if (menuRefPtr != NULL) {
3070
3071             /*
3072              * Find the menubar instance that is to be removed. Destroy
3073              * it and all of the cascades underneath it.
3074              */
3075
3076             if (menuRefPtr->menuPtr != NULL) {
3077                 TkMenu *instancePtr;
3078
3079                 menuPtr = menuRefPtr->menuPtr;
3080
3081                 for (instancePtr = menuPtr->masterMenuPtr;
3082                         instancePtr != NULL;
3083                         instancePtr = instancePtr->nextInstancePtr) {
3084                     if (instancePtr->menuType == MENUBAR
3085                             && instancePtr->parentTopLevelPtr == tkwin) {
3086                         RecursivelyDeleteMenu(instancePtr);
3087                         break;
3088                     }
3089                 }
3090             }
3091
3092             /*
3093              * Now we need to remove this toplevel from the list of toplevels
3094              * that reference this menu.
3095              */
3096
3097             for (topLevelListPtr = menuRefPtr->topLevelListPtr,
3098                     prevTopLevelPtr = NULL;
3099                     (topLevelListPtr != NULL)
3100                     && (topLevelListPtr->tkwin != tkwin);
3101                     prevTopLevelPtr = topLevelListPtr,
3102                     topLevelListPtr = topLevelListPtr->nextPtr) {
3103
3104                 /*
3105                  * Empty loop body.
3106                  */
3107
3108             }
3109
3110             /*
3111              * Now we have found the toplevel reference that matches the
3112              * tkwin; remove this reference from the list.
3113              */
3114
3115             if (topLevelListPtr != NULL) {
3116                 if (prevTopLevelPtr == NULL) {
3117                     menuRefPtr->topLevelListPtr =
3118                             menuRefPtr->topLevelListPtr->nextPtr;
3119                 } else {
3120                     prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr;
3121                 }
3122                 ckfree((char *) topLevelListPtr);
3123                 TkFreeMenuReferences(menuRefPtr);
3124             }
3125         }
3126     }
3127
3128     /*
3129      * Now, add the clone references for the new menu.
3130      */
3131
3132     if (menuName != NULL && menuName[0] != 0) {
3133         TkMenu *menuBarPtr = NULL;
3134
3135         menuRefPtr = TkCreateMenuReferences(interp, menuName);
3136
3137         menuPtr = menuRefPtr->menuPtr;
3138         if (menuPtr != NULL) {
3139             Tcl_Obj *cloneMenuPtr;
3140             TkMenuReferences *cloneMenuRefPtr;
3141             Tcl_Obj *newObjv[4];
3142             Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin),
3143                     -1);
3144             Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1);
3145
3146             /*
3147              * Clone the menu and all of the cascades underneath it.
3148              */
3149
3150             Tcl_IncrRefCount(windowNamePtr);
3151             cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
3152                     menuPtr);
3153             Tcl_IncrRefCount(cloneMenuPtr);
3154             Tcl_IncrRefCount(menubarPtr);
3155             CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
3156
3157             cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr);
3158             if ((cloneMenuRefPtr != NULL)
3159                     && (cloneMenuRefPtr->menuPtr != NULL)) {
3160                 Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1);
3161                 Tcl_Obj *nullPtr = Tcl_NewObj();
3162                 cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
3163                 menuBarPtr = cloneMenuRefPtr->menuPtr;
3164                 newObjv[0] = cursorPtr;
3165                 newObjv[1] = nullPtr;
3166                 Tcl_IncrRefCount(cursorPtr);
3167                 Tcl_IncrRefCount(nullPtr);
3168                 ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
3169                         2, newObjv);
3170                 Tcl_DecrRefCount(cursorPtr);
3171                 Tcl_DecrRefCount(nullPtr);
3172             }
3173
3174             TkpSetWindowMenuBar(tkwin, menuBarPtr);
3175             Tcl_DecrRefCount(cloneMenuPtr);
3176             Tcl_DecrRefCount(menubarPtr);
3177             Tcl_DecrRefCount(windowNamePtr);
3178         } else {
3179             TkpSetWindowMenuBar(tkwin, NULL);
3180         }
3181
3182
3183         /*
3184          * Add this window to the menu's list of windows that refer
3185          * to this menu.
3186          */
3187
3188         topLevelListPtr = (TkMenuTopLevelList *)
3189                 ckalloc(sizeof(TkMenuTopLevelList));
3190         topLevelListPtr->tkwin = tkwin;
3191         topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr;
3192         menuRefPtr->topLevelListPtr = topLevelListPtr;
3193     } else {
3194         TkpSetWindowMenuBar(tkwin, NULL);
3195     }
3196     TkpSetMainMenubar(interp, tkwin, menuName);
3197 }
3198 \f
3199 /*
3200  *----------------------------------------------------------------------
3201  *
3202  * DestroyMenuHashTable --
3203  *
3204  *      Called when an interp is deleted and a menu hash table has
3205  *      been set in it.
3206  *
3207  * Results:
3208  *      None.
3209  *
3210  * Side effects:
3211  *      The hash table is destroyed.
3212  *
3213  *----------------------------------------------------------------------
3214  */
3215
3216 static void
3217 DestroyMenuHashTable(clientData, interp)
3218     ClientData clientData;      /* The menu hash table we are destroying */
3219     Tcl_Interp *interp;         /* The interpreter we are destroying */
3220 {
3221     Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
3222     ckfree((char *) clientData);
3223 }
3224 \f
3225 /*
3226  *----------------------------------------------------------------------
3227  *
3228  * TkGetMenuHashTable --
3229  *
3230  *      For a given interp, give back the menu hash table that goes with
3231  *      it. If the hash table does not exist, it is created.
3232  *
3233  * Results:
3234  *      Returns a hash table pointer.
3235  *
3236  * Side effects:
3237  *      A new hash table is created if there were no table in the interp
3238  *      originally.
3239  *
3240  *----------------------------------------------------------------------
3241  */
3242
3243 Tcl_HashTable *
3244 TkGetMenuHashTable(interp)
3245     Tcl_Interp *interp;         /* The interp we need the hash table in.*/
3246 {
3247     Tcl_HashTable *menuTablePtr;
3248
3249     menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, MENU_HASH_KEY,
3250             NULL);
3251     if (menuTablePtr == NULL) {
3252         menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
3253         Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS);
3254         Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable,
3255                 (ClientData) menuTablePtr);
3256     }
3257     return menuTablePtr;
3258 }
3259 \f
3260 /*
3261  *----------------------------------------------------------------------
3262  *
3263  * TkCreateMenuReferences --
3264  *
3265  *      Given a pathname, gives back a pointer to a TkMenuReferences structure.
3266  *      If a reference is not already in the hash table, one is created.
3267  *
3268  * Results:
3269  *      Returns a pointer to a menu reference structure. Should not
3270  *      be freed by calller; when a field of the reference is cleared,
3271  *      TkFreeMenuReferences should be called.
3272  *
3273  * Side effects:
3274  *      A new hash table entry is created if there were no references
3275  *      to the menu originally.
3276  *
3277  *----------------------------------------------------------------------
3278  */
3279
3280 TkMenuReferences *
3281 TkCreateMenuReferences(interp, pathName)
3282     Tcl_Interp *interp;
3283     char *pathName;             /* The path of the menu widget */
3284 {
3285     Tcl_HashEntry *hashEntryPtr;
3286     TkMenuReferences *menuRefPtr;
3287     int newEntry;
3288     Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp);
3289
3290     hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry);
3291     if (newEntry) {
3292         menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences));
3293         menuRefPtr->menuPtr = NULL;
3294         menuRefPtr->topLevelListPtr = NULL;
3295         menuRefPtr->parentEntryPtr = NULL;
3296         menuRefPtr->hashEntryPtr = hashEntryPtr;
3297         Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr);
3298     } else {
3299         menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
3300     }
3301     return menuRefPtr;
3302 }
3303 \f
3304 /*
3305  *----------------------------------------------------------------------
3306  *
3307  * TkFindMenuReferences --
3308  *
3309  *      Given a pathname, gives back a pointer to the TkMenuReferences
3310  *      structure.
3311  *
3312  * Results:
3313  *      Returns a pointer to a menu reference structure. Should not
3314  *      be freed by calller; when a field of the reference is cleared,
3315  *      TkFreeMenuReferences should be called. Returns NULL if no reference
3316  *      with this pathname exists.
3317  *
3318  * Side effects:
3319  *      None.
3320  *
3321  *----------------------------------------------------------------------
3322  */
3323
3324 TkMenuReferences *
3325 TkFindMenuReferences(interp, pathName)
3326     Tcl_Interp *interp;         /* The interp the menu is living in. */
3327     char *pathName;             /* The path of the menu widget */
3328 {
3329     Tcl_HashEntry *hashEntryPtr;
3330     TkMenuReferences *menuRefPtr = NULL;
3331     Tcl_HashTable *menuTablePtr;
3332
3333     menuTablePtr = TkGetMenuHashTable(interp);
3334     hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName);
3335     if (hashEntryPtr != NULL) {
3336         menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
3337     }
3338     return menuRefPtr;
3339 }
3340 \f
3341 /*
3342  *----------------------------------------------------------------------
3343  *
3344  * TkFindMenuReferencesObj --
3345  *
3346  *      Given a pathname, gives back a pointer to the TkMenuReferences
3347  *      structure.
3348  *
3349  * Results:
3350  *      Returns a pointer to a menu reference structure. Should not
3351  *      be freed by calller; when a field of the reference is cleared,
3352  *      TkFreeMenuReferences should be called. Returns NULL if no reference
3353  *      with this pathname exists.
3354  *
3355  * Side effects:
3356  *      None.
3357  *
3358  *----------------------------------------------------------------------
3359  */
3360
3361 TkMenuReferences *
3362 TkFindMenuReferencesObj(interp, objPtr)
3363     Tcl_Interp *interp;         /* The interp the menu is living in. */
3364     Tcl_Obj *objPtr;            /* The path of the menu widget */
3365 {
3366     char *pathName = Tcl_GetStringFromObj(objPtr, NULL);
3367     return TkFindMenuReferences(interp, pathName);
3368 }
3369 \f
3370 /*
3371  *----------------------------------------------------------------------
3372  *
3373  * TkFreeMenuReferences --
3374  *
3375  *      This is called after one of the fields in a menu reference
3376  *      is cleared. It cleans up the ref if it is now empty.
3377  *
3378  * Results:
3379  *      None.
3380  *
3381  * Side effects:
3382  *      If this is the last field to be cleared, the menu ref is
3383  *      taken out of the hash table.
3384  *
3385  *----------------------------------------------------------------------
3386  */
3387
3388 void
3389 TkFreeMenuReferences(menuRefPtr)
3390     TkMenuReferences *menuRefPtr;               /* The menu reference to
3391                                                  * free */
3392 {
3393     if ((menuRefPtr->menuPtr == NULL)
3394             && (menuRefPtr->parentEntryPtr == NULL)
3395             && (menuRefPtr->topLevelListPtr == NULL)) {
3396         Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr);
3397         ckfree((char *) menuRefPtr);
3398     }
3399 }
3400 \f
3401 /*
3402  *----------------------------------------------------------------------
3403  *
3404  * DeleteMenuCloneEntries --
3405  *
3406  *      For every clone in this clone chain, delete the menu entries
3407  *      given by the parameters.
3408  *
3409  * Results:
3410  *      None.
3411  *
3412  * Side effects:
3413  *      The appropriate entries are deleted from all clones of this menu.
3414  *
3415  *----------------------------------------------------------------------
3416  */
3417
3418 static void
3419 DeleteMenuCloneEntries(menuPtr, first, last)
3420     TkMenu *menuPtr;                /* the menu the command was issued with */
3421     int first;                      /* the zero-based first entry in the set
3422                                      * of entries to delete. */
3423     int last;                       /* the zero-based last entry */
3424 {
3425
3426     TkMenu *menuListPtr;
3427     int numDeleted, i;
3428
3429     numDeleted = last + 1 - first;
3430     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
3431             menuListPtr = menuListPtr->nextInstancePtr) {
3432         for (i = last; i >= first; i--) {
3433             Tcl_EventuallyFree((ClientData) menuListPtr->entries[i],
3434                     DestroyMenuEntry);
3435         }
3436         for (i = last + 1; i < menuListPtr->numEntries; i++) {
3437             menuListPtr->entries[i - numDeleted] = menuListPtr->entries[i];
3438             menuListPtr->entries[i - numDeleted]->index = i - numDeleted;
3439         }
3440         menuListPtr->numEntries -= numDeleted;
3441         if (menuListPtr->numEntries == 0) {
3442             ckfree((char *) menuListPtr->entries);
3443             menuListPtr->entries = NULL;
3444         }
3445         if ((menuListPtr->active >= first)
3446                 && (menuListPtr->active <= last)) {
3447             menuListPtr->active = -1;
3448         } else if (menuListPtr->active > last) {
3449             menuListPtr->active -= numDeleted;
3450         }
3451         TkEventuallyRecomputeMenu(menuListPtr);
3452     }
3453 }
3454 \f
3455 /*
3456  *----------------------------------------------------------------------
3457  *
3458  * TkMenuInit --
3459  *
3460  *      Sets up the hash tables and the variables used by the menu package.
3461  *
3462  * Results:
3463  *      None.
3464  *
3465  * Side effects:
3466  *      lastMenuID gets initialized, and the parent hash and the command hash
3467  *      are allocated.
3468  *
3469  *----------------------------------------------------------------------
3470  */
3471
3472 void
3473 TkMenuInit()
3474 {
3475     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
3476             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
3477
3478     if (!menusInitialized) {
3479         Tcl_MutexLock(&menuMutex);
3480         if (!menusInitialized) {
3481             TkpMenuInit();
3482             menusInitialized = 1;
3483         }
3484         Tcl_MutexUnlock(&menuMutex);
3485     }
3486     if (!tsdPtr->menusInitialized) {
3487         TkpMenuThreadInit();
3488         tsdPtr->menusInitialized = 1;
3489     }
3490 }