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