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