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