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