← Back to branch summary

~ubuntu-branches/ubuntu/dapper/perl-tk/dapper

« back to all changes in this revision

Viewing changes to pTk/mTk/generic/tkMenu.c

  • Committer: Bazaar Package Importer
  • Author(s): Michael C. Schultheiss
  • Date: 2006-01-16 16:54:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060116165402-1ppygm8hh8ahel2x
Tags: 1:804.027-2
http://bugs.debian.org/348086
* Incorporate changes from NMU (Thanks to Steve Kowalik.
  Closes: #348086)
* debian/control: Update Standards-Version (no changes needed)

Show diffs side-by-side

added added

removed removed

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