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