summaryrefslogtreecommitdiffstats
path: root/generic/tkMenu.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkMenu.c')
-rw-r--r--generic/tkMenu.c2209
1 files changed, 1302 insertions, 907 deletions
diff --git a/generic/tkMenu.c b/generic/tkMenu.c
index cbcdcb8..5a3de18 100644
--- a/generic/tkMenu.c
+++ b/generic/tkMenu.c
@@ -7,12 +7,12 @@
* and drawing code for menus is in the file tkMenuDraw.c
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMenu.c,v 1.2 1998/09/14 18:23:14 stanton Exp $
+ * RCS: @(#) $Id: tkMenu.c,v 1.3 1999/04/16 01:51:19 stanton Exp $
*/
/*
@@ -68,174 +68,247 @@
*
*/
+#if 0
+
+/*
+ * used only to test for old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
#include "tkPort.h"
#include "tkMenu.h"
#define MENU_HASH_KEY "tkMenus"
-static int menusInitialized; /* Whether or not the hash tables, etc., have
- * been setup */
+typedef struct ThreadSpecificData {
+ int menusInitialized; /* Flag indicates whether thread-specific
+ * elements of the Windows Menu module
+ * have been initialized. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following flag indicates whether the process-wide state for
+ * the Menu module has been intialized. The Mutex protects access to
+ * that flag.
+ */
+
+static int menusInitialized;
+TCL_DECLARE_MUTEX(menuMutex)
/*
* Configuration specs for individual menu entries. If this changes, be sure
* to update code in TkpMenuInit that changes the font string entry.
*/
-Tk_ConfigSpec tkMenuEntryConfigSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
- {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |SEPARATOR_MASK|TEAROFF_MASK},
- {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
- {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name),
- CASCADE_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue),
- RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name),
- CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name),
- RADIO_BUTTON_MASK},
- {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL};
+
+static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command",
+ "radiobutton", "separator", (char *) NULL};
+
+Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_FG,
+ Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACCELERATOR,
+ Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BITMAP,
+ Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COLUMN_BREAK,
+ -1, Tk_Offset(TkMenuEntry, columnBreak)},
+ {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COMMAND,
+ Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FONT,
+ Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FG,
+ Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_HIDE_MARGIN,
+ -1, Tk_Offset(TkMenuEntry, hideMargin)},
+ {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_IMAGE,
+ Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_LABEL,
+ Tk_Offset(TkMenuEntry, labelPtr), -1, 0},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE,
+ -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_OFF_VALUE,
+ Tk_Offset(TkMenuEntry, offValuePtr), -1},
+ {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ON_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_CHECK_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_RADIO_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
};
+Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
+ {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_MENU,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_END}
+};
+
+static Tk_OptionSpec *specsArray[] = {
+ tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
+ tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
+ tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs};
+
/*
- * Configuration specs valid for the menu as a whole. If this changes, be sure
- * to update code in TkpMenuInit that changes the font string entry.
+ * Menu type strings for use with Tcl_GetIndexFromObj.
*/
-Tk_ConfigSpec tkMenuConfigSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth",
+static char *menuTypeStrings[] = {"normal", "tearoff", "menubar",
+ (char *) NULL};
+
+Tk_OptionSpec tkMenuConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground",
+ "Foreground", DEF_MENU_ACTIVE_BG_COLOR,
+ Tk_Offset(TkMenu, activeBorderPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_BG_MONO},
+ {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
"BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
- Tk_Offset(TkMenu, activeBorderWidth), 0},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ Tk_Offset(TkMenu, activeBorderWidthPtr), -1},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground",
+ "Background", DEF_MENU_ACTIVE_FG_COLOR,
+ Tk_Offset(TkMenu, activeFgPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_FG_MONO},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0,
+ (ClientData) DEF_MENU_BG_MONO},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background"},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENU_BORDER_WIDTH,
+ Tk_Offset(TkMenu, borderWidthPtr), -1, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENU_CURSOR,
+ Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
"DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
- Tk_Offset(TkMenu, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
- "DisabledForeground", DEF_MENU_DISABLED_FG_MONO,
- Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0},
- {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command",
- DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0},
- {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
- DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
- DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff",
- DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0},
- {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand",
- DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-title", "title", "Title",
- DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-type", "type", "Type",
- DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+ Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENU_DISABLED_FG_MONO},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1},
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
+ DEF_MENU_POST_COMMAND,
+ Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,
+ (ClientData) DEF_MENU_SELECT_MONO},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENU_TAKE_FOCUS,
+ Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
+ DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)},
+ {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",
+ "TearOffCommand", DEF_MENU_TEAROFF_CMD,
+ Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-title", "title", "Title",
+ DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
+ DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) menuTypeStrings},
+ {TK_OPTION_END}
+};
+
+/*
+ * Command line options. Put here because MenuCmd has to look at them
+ * along with MenuWidgetObjCmd.
+ */
+
+static char *menuOptions[] = {
+ "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
+ "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
+ "type", "unpost", "yposition", (char *) NULL
+};
+enum options {
+ MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
+ MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
+ MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
+ MENU_UNPOST, MENU_YPOSITION
};
/*
@@ -243,15 +316,14 @@ Tk_ConfigSpec tkMenuConfigSpecs[] = {
*/
static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
- char *newMenuName, char *newMenuTypeString));
+ Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString));
static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, int argc, char **argv,
- int flags));
+ TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[]));
static int ConfigureMenuCloneEntries _ANSI_ARGS_((
Tcl_Interp *interp, TkMenu *menuPtr, int index,
- int argc, char **argv, int flags));
+ int objc, Tcl_Obj *CONST objv[]));
static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
- int argc, char **argv, int flags));
+ int objc, Tcl_Obj *CONST objv[]));
static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
int first, int last));
static void DestroyMenuHashTable _ANSI_ARGS_((
@@ -262,10 +334,13 @@ static int GetIndexFromCoords
_ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
char *string, int *indexPtr));
static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, char *arg));
+ TkMenu *menuPtr, Tcl_Obj *objPtr));
static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, char *indexString, int argc,
- char **argv));
+ TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int MenuCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static void MenuCmdDeletedProc _ANSI_ARGS_((
ClientData clientData));
static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
@@ -273,10 +348,12 @@ static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
static char * MenuVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static int MenuWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static void MenuWorldChanged _ANSI_ARGS_((
ClientData instanceData));
+static int PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
@@ -290,13 +367,61 @@ static TkClassProcs menuClass = {
NULL, /* createProc. */
MenuWorldChanged /* geometryProc. */
};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateMenuCmd --
+ *
+ * Called by Tk at initialization time to create the menu
+ * command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TkCreateMenuCmd(interp)
+ Tcl_Interp *interp; /* Interpreter we are creating the
+ * command in. */
+{
+ TkMenuOptionTables *optionTablesPtr =
+ (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables));
+
+ optionTablesPtr->menuOptionTable =
+ Tk_CreateOptionTable(interp, tkMenuConfigSpecs);
+ optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]);
+ optionTablesPtr->entryOptionTables[COMMAND_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]);
+ optionTablesPtr->entryOptionTables[CASCADE_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]);
+ optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]);
+ optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]);
+ optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]);
+
+ Tcl_CreateObjCommand(interp, "menu", MenuCmd,
+ (ClientData) optionTablesPtr, NULL);
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "menu", "menu");
+ }
+ return TCL_OK;
+}
/*
*--------------------------------------------------------------
*
- * Tk_MenuCmd --
+ * MenuCmd --
*
* This procedure is invoked to process the "menu" Tcl
* command. See the user documentation for details on
@@ -311,48 +436,45 @@ static TkClassProcs menuClass = {
*--------------------------------------------------------------
*/
-int
-Tk_MenuCmd(clientData, interp, argc, argv)
+static int
+MenuCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = Tk_MainWindow(interp);
Tk_Window new;
register TkMenu *menuPtr;
TkMenuReferences *menuRefPtr;
- int i, len;
- char *arg, c;
+ int i, index;
int toplevel;
+ char *windowName;
+ static char *typeStringList[] = {"-type", (char *) NULL};
+ TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
TkMenuInit();
toplevel = 1;
- for (i = 2; i < argc; i += 2) {
- arg = argv[i];
- len = strlen(arg);
- if (len < 2) {
- continue;
- }
- c = arg[1];
- if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0)
- && (len >= 3)) {
- if (strcmp(argv[i + 1], "menubar") == 0) {
+ for (i = 2; i < (objc - 1); i++) {
+ if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index)
+ != TCL_ERROR) {
+ if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL,
+ 0, &index) == TCL_OK) && (index == MENUBAR)) {
toplevel = 0;
}
break;
}
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? ""
+ windowName = Tcl_GetStringFromObj(objv[1], NULL);
+ new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? ""
: NULL);
if (new == NULL) {
return TCL_ERROR;
@@ -366,27 +488,27 @@ Tk_MenuCmd(clientData, interp, argc, argv)
menuPtr->tkwin = new;
menuPtr->display = Tk_Display(new);
menuPtr->interp = interp;
- menuPtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(menuPtr->tkwin), MenuWidgetCmd,
+ menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd,
(ClientData) menuPtr, MenuCmdDeletedProc);
menuPtr->entries = NULL;
menuPtr->numEntries = 0;
menuPtr->active = -1;
- menuPtr->border = NULL;
- menuPtr->borderWidth = 0;
- menuPtr->relief = TK_RELIEF_FLAT;
- menuPtr->activeBorder = NULL;
- menuPtr->activeBorderWidth = 0;
- menuPtr->tkfont = NULL;
- menuPtr->fg = NULL;
- menuPtr->disabledFg = NULL;
- menuPtr->activeFg = NULL;
- menuPtr->indicatorFg = NULL;
- menuPtr->tearOff = 1;
- menuPtr->tearOffCommand = NULL;
- menuPtr->cursor = None;
- menuPtr->takeFocus = NULL;
- menuPtr->postCommand = NULL;
+ menuPtr->borderPtr = NULL;
+ menuPtr->borderWidthPtr = NULL;
+ menuPtr->reliefPtr = NULL;
+ menuPtr->activeBorderPtr = NULL;
+ menuPtr->activeBorderWidthPtr = NULL;
+ menuPtr->fontPtr = NULL;
+ menuPtr->fgPtr = NULL;
+ menuPtr->disabledFgPtr = NULL;
+ menuPtr->activeFgPtr = NULL;
+ menuPtr->indicatorFgPtr = NULL;
+ menuPtr->tearoff = 0;
+ menuPtr->tearoffCommandPtr = NULL;
+ menuPtr->cursorPtr = None;
+ menuPtr->takeFocusPtr = NULL;
+ menuPtr->postCommandPtr = NULL;
menuPtr->postCommandGeneration = 0;
menuPtr->postedCascade = NULL;
menuPtr->nextInstancePtr = NULL;
@@ -394,24 +516,38 @@ Tk_MenuCmd(clientData, interp, argc, argv)
menuPtr->menuType = UNKNOWN_TYPE;
menuPtr->menuFlags = 0;
menuPtr->parentTopLevelPtr = NULL;
- menuPtr->menuTypeName = NULL;
- menuPtr->title = NULL;
+ menuPtr->menuTypePtr = NULL;
+ menuPtr->titlePtr = NULL;
+ menuPtr->errorStructPtr = NULL;
+ menuPtr->optionTablesPtr = optionTablesPtr;
TkMenuInitializeDrawingFields(menuPtr);
+ Tk_SetClass(menuPtr->tkwin, "Menu");
+ TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
+ if (Tk_InitOptions(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
+ }
+
+
menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
Tk_PathName(menuPtr->tkwin));
menuRefPtr->menuPtr = menuPtr;
menuPtr->menuRefPtr = menuRefPtr;
if (TCL_OK != TkpNewMenu(menuPtr)) {
- goto error;
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
}
- Tk_SetClass(menuPtr->tkwin, "Menu");
- TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
TkMenuEventProc, (ClientData) menuPtr);
- if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
+ if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
}
/*
@@ -434,8 +570,8 @@ Tk_MenuCmd(clientData, interp, argc, argv)
if (menuRefPtr->parentEntryPtr != NULL) {
TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
TkMenuEntry *nextCascadePtr;
- char *newMenuName;
- char *newArgv[2];
+ Tcl_Obj *newMenuName;
+ Tcl_Obj *newObjv[2];
while (cascadeListPtr != NULL) {
@@ -454,28 +590,38 @@ Tk_MenuCmd(clientData, interp, argc, argv)
|| ((menuPtr->masterMenuPtr == menuPtr)
&& ((cascadeListPtr->menuPtr->masterMenuPtr
== cascadeListPtr->menuPtr)))) {
- newArgv[0] = "-menu";
- newArgv[1] = Tk_PathName(menuPtr->tkwin);
- ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
} else {
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(
+ Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1);
+
+ Tcl_IncrRefCount(normalPtr);
+ Tcl_IncrRefCount(windowNamePtr);
newMenuName = TkNewMenuName(menuPtr->interp,
- Tk_PathName(cascadeListPtr->menuPtr->tkwin),
- menuPtr);
- CloneMenu(menuPtr, newMenuName, "normal");
+ windowNamePtr, menuPtr);
+ Tcl_IncrRefCount(newMenuName);
+ CloneMenu(menuPtr, newMenuName, normalPtr);
/*
* Now we can set the new menu instance to be the cascade entry
* of the parent's instance.
*/
- newArgv[0] = "-menu";
- newArgv[1] = newMenuName;
- ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
- if (newMenuName != NULL) {
- ckfree(newMenuName);
- }
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newMenuName;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ Tcl_DecrRefCount(windowNamePtr);
}
cascadeListPtr = nextCascadePtr;
}
@@ -507,18 +653,14 @@ Tk_MenuCmd(clientData, interp, argc, argv)
}
}
- interp->result = Tk_PathName(menuPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC);
return TCL_OK;
-
- error:
- Tk_DestroyWindow(menuPtr->tkwin);
- return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
- * MenuWidgetCmd --
+ * MenuWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a widget managed by this module.
@@ -534,317 +676,351 @@ Tk_MenuCmd(clientData, interp, argc, argv)
*/
static int
-MenuWidgetCmd(clientData, interp, argc, argv)
+MenuWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about menu widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
register TkMenu *menuPtr = (TkMenu *) clientData;
register TkMenuEntry *mePtr;
int result = TCL_OK;
- size_t length;
- int c;
+ int option;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0,
+ &option) != TCL_OK) {
return TCL_ERROR;
}
Tcl_Preserve((ClientData) menuPtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)
- && (length >= 2)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " activate index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (menuPtr->active == index) {
- goto done;
- }
- if (index >= 0) {
- if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
- || (menuPtr->entries[index]->state == tkDisabledUid)) {
+
+ switch ((enum options) option) {
+ case MENU_ACTIVATE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "activate index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (menuPtr->active == index) {
+ goto done;
+ }
+ if ((index >= 0)
+ && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
+ || (menuPtr->entries[index]->state
+ == ENTRY_DISABLED))) {
index = -1;
}
+ result = TkActivateMenuEntry(menuPtr, index);
+ break;
}
- result = TkActivateMenuEntry(menuPtr, index);
- } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)
- && (length >= 2)) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " add type ?options?\"", (char *) NULL);
- goto error;
+ case MENU_ADD:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?");
+ goto error;
+ }
+
+ if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL,
+ objc - 2, objv + 2) != TCL_OK) {
+ goto error;
+ }
+ break;
+ case MENU_CGET: {
+ Tcl_Obj *resultPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, objv[2],
+ menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
}
- if (MenuAddOrInsert(interp, menuPtr, (char *) NULL,
- argc-2, argv+2) != TCL_OK) {
- goto error;
+ case MENU_CLONE:
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "clone newMenuName ?menuType?");
+ goto error;
+ }
+ result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]);
+ break;
+ case MENU_CONFIGURE: {
+ Tcl_Obj *resultPtr;
+
+ if (objc == 2) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable,
+ (Tcl_Obj *) NULL, menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else if (objc == 3) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable,
+ objv[2], menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2);
+ }
+ if (result != TCL_OK) {
+ goto error;
+ }
+ break;
}
- } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
+ case MENU_DELETE: {
+ int first, last;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first)
+ != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first;
+ } else {
+ if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last)
+ != TCL_OK) {
+ goto error;
+ }
+ }
+ if (menuPtr->tearoff && (first == 0)) {
+
+ /*
+ * Sorry, can't delete the tearoff entry; must reconfigure
+ * the menu.
+ */
+
+ first = 1;
+ }
+ if ((first < 0) || (last < first)) {
+ goto done;
+ }
+ DeleteMenuCloneEntries(menuPtr, first, last);
+ break;
}
- result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs,
- (char *) menuPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0)
- && (length >=2)) {
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " clone newMenuName ?menuType?\"",
- (char *) NULL);
- goto error;
- }
- result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0);
- } else {
- result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
+ case MENU_ENTRYCGET: {
+ int index;
+ Tcl_Obj *resultPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ resultPtr = Tk_GetOptionValue(interp, (char *) mePtr,
+ mePtr->optionTable, objv[3], menuPtr->tkwin);
+ Tcl_Release((ClientData) mePtr);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
}
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- int first, last;
+ case MENU_ENTRYCONFIGURE: {
+ int index;
+ Tcl_Obj *resultPtr;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " delete first ?last?\"", (char *) NULL);
- goto error;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "entryconfigure index ?option value ...?");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ Tcl_Preserve((ClientData) mePtr);
+ if (objc == 3) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
+ mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else if (objc == 4) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
+ mePtr->optionTable, objv[3], menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ result = ConfigureMenuCloneEntries(interp, menuPtr, index,
+ objc - 3, objv + 3);
+ }
+ Tcl_Release((ClientData) mePtr);
+ break;
}
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
+ case MENU_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "index string");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ Tcl_SetResult(interp, "none", TCL_STATIC);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ }
+ break;
}
- if (argc == 3) {
- last = first;
- } else {
- if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) {
- goto error;
+ case MENU_INSERT:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "insert index type ?options?");
+ goto error;
+ }
+ if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3,
+ objv + 3) != TCL_OK) {
+ goto error;
+ }
+ break;
+ case MENU_INVOKE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
}
+ if (index < 0) {
+ goto done;
+ }
+ result = TkInvokeMenu(interp, menuPtr, index);
+ break;
}
- if (menuPtr->tearOff && (first == 0)) {
+ case MENU_POST: {
+ int x, y;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "post x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
/*
- * Sorry, can't delete the tearoff entry; must reconfigure
- * the menu.
+ * Tearoff menus are posted differently on Mac and Windows than
+ * non-tearoffs. TkpPostMenu does not actually map the menu's
+ * window on those platforms, and popup menus have to be
+ * handled specially.
*/
- first = 1;
- }
- if ((first < 0) || (last < first)) {
- goto done;
- }
- DeleteMenuCloneEntries(menuPtr, first, last);
- } else if ((c == 'e') && (length >= 7)
- && (strncmp(argv[1], "entrycget", length) == 0)) {
- int index;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " entrycget index option\"",
- (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- Tcl_Preserve((ClientData) mePtr);
- result = Tk_ConfigureValue(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
- COMMAND_MASK << mePtr->type);
- Tcl_Release((ClientData) mePtr);
- } else if ((c == 'e') && (length >= 7)
- && (strncmp(argv[1], "entryconfigure", length) == 0)) {
- int index;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " entryconfigure index ?option value ...?\"",
- (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- Tcl_Preserve((ClientData) mePtr);
- if (argc == 3) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL,
- COMMAND_MASK << mePtr->type);
- } else if (argc == 4) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
- COMMAND_MASK << mePtr->type);
- } else {
- result = ConfigureMenuCloneEntries(interp, menuPtr, index,
- argc-3, argv+3,
- TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type);
- }
- Tcl_Release((ClientData) mePtr);
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index string\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- interp->result = "none";
- } else {
- sprintf(interp->result, "%d", index);
- }
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert index type ?options?\"", (char *) NULL);
- goto error;
- }
- if (MenuAddOrInsert(interp, menuPtr, argv[2],
- argc-3, argv+3) != TCL_OK) {
- goto error;
+ if (menuPtr->menuType != TEAROFF_MENU) {
+ result = TkpPostMenu(interp, menuPtr, x, y);
+ } else {
+ result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ }
+ break;
}
- } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
- && (length >= 3)) {
- int index;
+ case MENU_POSTCASCADE: {
+ int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " invoke index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- result = TkInvokeMenu(interp, menuPtr, index);
- } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0)
- && (length == 4)) {
- int x, y;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " post x y\"", (char *) NULL);
- goto error;
- }
- if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
- goto error;
- }
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postcascade index");
+ goto error;
+ }
- /*
- * Tearoff menus are posted differently on Mac and Windows than
- * non-tearoffs. TkpPostMenu does not actually map the menu's
- * window on those platforms, and popup menus have to be
- * handled specially.
- */
-
- if (menuPtr->menuType != TEAROFF_MENU) {
- result = TkpPostMenu(interp, menuPtr, x, y);
- } else {
- result = TkPostTearoffMenu(interp, menuPtr, x, y);
- }
- } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0)
- && (length > 4)) {
- int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " postcascade index\"", (char *) NULL);
- goto error;
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if ((index < 0) || (menuPtr->entries[index]->type
+ != CASCADE_ENTRY)) {
+ result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
+ } else {
+ result = TkPostSubmenu(interp, menuPtr,
+ menuPtr->entries[index]);
+ }
+ break;
}
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
+ case MENU_TYPE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
+ Tcl_SetResult(interp, "tearoff", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp,
+ menuEntryTypeStrings[menuPtr->entries[index]->type],
+ TCL_STATIC);
+ }
+ break;
}
- if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {
+ case MENU_UNPOST:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "unpost");
+ goto error;
+ }
+ Tk_UnmapWindow(menuPtr->tkwin);
result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
- } else {
- result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);
- }
- } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
- int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " type index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- switch (mePtr->type) {
- case COMMAND_ENTRY:
- interp->result = "command";
- break;
- case SEPARATOR_ENTRY:
- interp->result = "separator";
- break;
- case CHECK_BUTTON_ENTRY:
- interp->result = "checkbutton";
- break;
- case RADIO_BUTTON_ENTRY:
- interp->result = "radiobutton";
- break;
- case CASCADE_ENTRY:
- interp->result = "cascade";
- break;
- case TEAROFF_ENTRY:
- interp->result = "tearoff";
- break;
- }
- } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " unpost\"", (char *) NULL);
- goto error;
- }
- Tk_UnmapWindow(menuPtr->tkwin);
- result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
- } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " yposition index\"", (char *) NULL);
- goto error;
- }
- result = MenuDoYPosition(interp, menuPtr, argv[2]);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be activate, add, cget, clone, configure, delete, ",
- "entrycget, entryconfigure, index, insert, invoke, ",
- "post, postcascade, type, unpost, or yposition",
- (char *) NULL);
- goto error;
+ break;
+ case MENU_YPOSITION:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "yposition index");
+ goto error;
+ }
+ result = MenuDoYPosition(interp, menuPtr, objv[2]);
+ break;
}
done:
Tcl_Release((ClientData) menuPtr);
@@ -854,7 +1030,6 @@ MenuWidgetCmd(clientData, interp, argc, argv)
Tcl_Release((ClientData) menuPtr);
return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
@@ -888,45 +1063,60 @@ TkInvokeMenu(interp, menuPtr, index)
goto done;
}
mePtr = menuPtr->entries[index];
- if (mePtr->state == tkDisabledUid) {
+ if (mePtr->state == ENTRY_DISABLED) {
goto done;
}
Tcl_Preserve((ClientData) mePtr);
if (mePtr->type == TEAROFF_ENTRY) {
- Tcl_DString commandDString;
-
- Tcl_DStringInit(&commandDString);
- Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu");
- Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin));
- result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString));
- Tcl_DStringFree(&commandDString);
- } else if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1);
+ Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
+ result = Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr;
+
if (mePtr->entryFlags & ENTRY_SELECTED) {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- }
+ valuePtr = mePtr->offValuePtr;
} else {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- }
+ valuePtr = mePtr->onValuePtr;
+ }
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ } else if ((mePtr->type == RADIO_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr = mePtr->onValuePtr;
+
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
}
- } else if (mePtr->type == RADIO_BUTTON_ENTRY) {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
}
+ Tcl_DecrRefCount(valuePtr);
}
- if ((result == TCL_OK) && (mePtr->command != NULL)) {
- result = TkCopyAndGlobalEval(interp, mePtr->command);
+ if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) {
+ Tcl_Obj *commandPtr = mePtr->commandPtr;
+
+ Tcl_IncrRefCount(commandPtr);
+ result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(commandPtr);
}
Tcl_Release((ClientData) mePtr);
done:
return result;
}
-
-
/*
*----------------------------------------------------------------------
@@ -951,13 +1141,12 @@ static void
DestroyMenuInstance(menuPtr)
TkMenu *menuPtr; /* Info about menu widget. */
{
- int i, numEntries = menuPtr->numEntries;
+ int i;
TkMenu *menuInstancePtr;
TkMenuEntry *cascadePtr, *nextCascadePtr;
- char *newArgv[2];
+ Tcl_Obj *newObjv[2];
TkMenu *parentMasterMenuPtr;
TkMenuEntry *parentMasterEntryPtr;
- TkMenu *parentMenuPtr;
/*
* If the menu has any cascade menu entries pointing to it, the cascade
@@ -979,18 +1168,23 @@ DestroyMenuInstance(menuPtr)
TkFreeMenuReferences(menuPtr->menuRefPtr);
for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
- parentMenuPtr = cascadePtr->menuPtr;
nextCascadePtr = cascadePtr->nextCascadePtr;
if (menuPtr->masterMenuPtr != menuPtr) {
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+
parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
parentMasterEntryPtr =
parentMasterMenuPtr->entries[cascadePtr->index];
- newArgv[0] = "-menu";
- newArgv[1] = parentMasterEntryPtr->name;
- ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = parentMasterEntryPtr->namePtr;
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadePtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
} else {
- ConfigureMenuEntry(cascadePtr, 0, (char **) NULL, 0);
+ ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL);
}
}
@@ -1010,20 +1204,27 @@ DestroyMenuInstance(menuPtr)
/*
* Free up all the stuff that requires special handling, then
- * let Tk_FreeOptions handle all the standard option-related
+ * let Tk_FreeConfigurationOptions handle all the standard option-related
* stuff.
*/
- for (i = numEntries - 1; i >= 0; i--) {
+ for (i = menuPtr->numEntries; --i >= 0; ) {
+ /*
+ * As each menu entry is deleted from the end of the array of
+ * entries, decrement menuPtr->numEntries. Otherwise, the act of
+ * deleting menu entry i will dereference freed memory attempting
+ * to queue a redraw for menu entries (i+1)...numEntries.
+ */
+
DestroyMenuEntry((char *) menuPtr->entries[i]);
+ menuPtr->numEntries = i;
}
if (menuPtr->entries != NULL) {
ckfree((char *) menuPtr->entries);
}
TkMenuFreeDrawOptions(menuPtr);
- Tk_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0);
-
- Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
+ Tk_FreeConfigOptions((char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin);
}
/*
@@ -1202,7 +1403,7 @@ DestroyMenuEntry(memPtr)
/*
* Free up all the stuff that requires special handling, then
- * let Tk_FreeOptions handle all the standard option-related
+ * let Tk_FreeConfigurationOptions handle all the standard option-related
* stuff.
*/
@@ -1215,15 +1416,17 @@ DestroyMenuEntry(memPtr)
if (mePtr->selectImage != NULL) {
Tk_FreeImage(mePtr->selectImage);
}
- if (mePtr->name != NULL) {
- Tcl_UntraceVar(menuPtr->interp, mePtr->name,
+ if (((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))
+ && (mePtr->namePtr != NULL)) {
+ char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_UntraceVar(menuPtr->interp, varName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuVarProc, (ClientData) mePtr);
}
TkpDestroyMenuEntry(mePtr);
TkMenuEntryFreeDrawOptions(mePtr);
- Tk_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display,
- (COMMAND_MASK << mePtr->type));
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
ckfree((char *) mePtr);
}
@@ -1259,7 +1462,6 @@ MenuWorldChanged(instanceData)
TkpConfigureMenuEntry(menuPtr->entries[i]);
}
}
-
/*
*----------------------------------------------------------------------
@@ -1272,7 +1474,7 @@ MenuWorldChanged(instanceData)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, font, etc. get set
@@ -1282,23 +1484,32 @@ MenuWorldChanged(instanceData)
*/
static int
-ConfigureMenu(interp, menuPtr, argc, argv, flags)
+ConfigureMenu(interp, menuPtr, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
register TkMenu *menuPtr; /* Information about widget; may or may
* not already have values for some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
{
int i;
- TkMenu* menuListPtr;
+ TkMenu *menuListPtr, *cleanupPtr;
+ int result;
for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
menuListPtr = menuListPtr->nextInstancePtr) {
-
- if (Tk_ConfigureWidget(interp, menuListPtr->tkwin,
- tkMenuConfigSpecs, argc, argv, (char *) menuListPtr,
- flags) != TCL_OK) {
+ menuListPtr->errorStructPtr = (Tk_SavedOptions *)
+ ckalloc(sizeof(Tk_SavedOptions));
+ result = Tk_SetOptions(interp, (char *) menuListPtr,
+ menuListPtr->optionTablesPtr->menuOptionTable, objc, objv,
+ menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL);
+ if (result != TCL_OK) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
return TCL_ERROR;
}
@@ -1310,33 +1521,57 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
*/
if (menuListPtr->menuType == UNKNOWN_TYPE) {
- if (strcmp(menuListPtr->menuTypeName, "menubar") == 0) {
- menuListPtr->menuType = MENUBAR;
- } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
- menuListPtr->menuType = TEAROFF_MENU;
- } else {
- menuListPtr->menuType = MASTER_MENU;
+ Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr,
+ menuTypeStrings, NULL, 0, &menuListPtr->menuType);
+
+ /*
+ * Configure the new window to be either a pop-up menu
+ * or a tear-off menu.
+ * We don't do this for menubars since they are not toplevel
+ * windows. Also, since this gets called before CloneMenu has
+ * a chance to set the menuType field, we have to look at the
+ * menuTypeName field to tell that this is a menu bar.
+ */
+
+ if (menuListPtr->menuType == MASTER_MENU) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 1);
+ } else if (menuListPtr->menuType == TEAROFF_MENU) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, 0);
}
}
-
+
+
/*
* Depending on the -tearOff option, make sure that there is or
* isn't an initial tear-off entry at the beginning of the menu.
*/
- if (menuListPtr->tearOff) {
+ if (menuListPtr->tearoff) {
if ((menuListPtr->numEntries == 0)
|| (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
+ if (menuListPtr->errorStructPtr != NULL) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
return TCL_ERROR;
}
}
} else if ((menuListPtr->numEntries > 0)
&& (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
int i;
-
+
Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
DestroyMenuEntry);
+
for (i = 0; i < menuListPtr->numEntries - 1; i++) {
menuListPtr->entries[i] = menuListPtr->entries[i + 1];
menuListPtr->entries[i]->index = i;
@@ -1349,21 +1584,6 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
}
TkMenuConfigureDrawOptions(menuListPtr);
-
- /*
- * Configure the new window to be either a pop-up menu
- * or a tear-off menu.
- * We don't do this for menubars since they are not toplevel
- * windows. Also, since this gets called before CloneMenu has
- * a chance to set the menuType field, we have to look at the
- * menuTypeName field to tell that this is a menu bar.
- */
-
- if (strcmp(menuListPtr->menuTypeName, "normal") == 0) {
- TkpMakeMenuWindow(menuListPtr->tkwin, 1);
- } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
- TkpMakeMenuWindow(menuListPtr->tkwin, 0);
- }
/*
* After reconfiguring a menu, we need to reconfigure all of the
@@ -1376,28 +1596,35 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
TkMenuEntry *mePtr;
mePtr = menuListPtr->entries[i];
- ConfigureMenuEntry(mePtr, 0,
- (char **) NULL, TK_CONFIG_ARGV_ONLY
- | COMMAND_MASK << mePtr->type);
+ ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL);
}
TkEventuallyRecomputeMenu(menuListPtr);
}
+ for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_FreeSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+
return TCL_OK;
}
+
/*
*----------------------------------------------------------------------
*
- * ConfigureMenuEntry --
+ * PostProcessEntry --
*
- * This procedure is called to process an argv/argc list in order
- * to configure (or reconfigure) one entry in a menu.
+ * This is called by ConfigureMenuEntry to do all of the configuration
+ * after Tk_SetOptions is called. This is separate
+ * so that error handling is easier.
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information such as label and accelerator get
@@ -1407,55 +1634,29 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
*/
static int
-ConfigureMenuEntry(mePtr, argc, argv, flags)
- register TkMenuEntry *mePtr; /* Information about menu entry; may
- * or may not already have values for
- * some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Additional flags to pass to
- * Tk_ConfigureWidget. */
+PostProcessEntry(mePtr)
+ TkMenuEntry *mePtr; /* The entry we are configuring. */
{
TkMenu *menuPtr = mePtr->menuPtr;
int index = mePtr->index;
+ char *name;
Tk_Image image;
/*
- * If this entry is a check button or radio button, then remove
- * its old trace procedure.
- */
-
- if ((mePtr->name != NULL)
- && ((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY))) {
- Tcl_UntraceVar(menuPtr->interp, mePtr->name,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuVarProc, (ClientData) mePtr);
- }
-
- if (menuPtr->tkwin != NULL) {
- if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr,
- flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) {
- return TCL_ERROR;
- }
- }
-
- /*
* The code below handles special configuration stuff not taken
* care of by Tk_ConfigureWidget, such as special processing for
* defaults, sizing strings, graphics contexts, etc.
*/
- if (mePtr->label == NULL) {
+ if (mePtr->labelPtr == NULL) {
mePtr->labelLength = 0;
} else {
- mePtr->labelLength = strlen(mePtr->label);
+ Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
}
- if (mePtr->accel == NULL) {
+ if (mePtr->accelPtr == NULL) {
mePtr->accelLength = 0;
} else {
- mePtr->accelLength = strlen(mePtr->accel);
+ Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
}
/*
@@ -1464,9 +1665,8 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
* cascades have to be updated.
*/
- if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
TkMenuEntry *cascadeEntryPtr;
- TkMenu *cascadeMenuPtr;
int alreadyThere;
TkMenuReferences *menuRefPtr;
char *oldHashKey = NULL; /* Initialization only needed to
@@ -1482,19 +1682,18 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
* BUG: We are not recloning for special case #3 yet.
*/
+ name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
if (mePtr->childMenuRefPtr != NULL) {
oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
mePtr->childMenuRefPtr->hashEntryPtr);
- if (strcmp(oldHashKey, mePtr->name) != 0) {
+ if (strcmp(oldHashKey, name) != 0) {
UnhookCascadeEntry(mePtr);
}
}
if ((mePtr->childMenuRefPtr == NULL)
- || (strcmp(oldHashKey, mePtr->name) != 0)) {
- menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
- mePtr->name);
- cascadeMenuPtr = menuRefPtr->menuPtr;
+ || (strcmp(oldHashKey, name) != 0)) {
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);
mePtr->childMenuRefPtr = menuRefPtr;
if (menuRefPtr->parentEntryPtr == NULL) {
@@ -1531,52 +1730,15 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
return TCL_ERROR;
}
- if ((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY)) {
- char *value;
-
- if (mePtr->name == NULL) {
- mePtr->name =
- (char *) ckalloc((unsigned) (mePtr->labelLength + 1));
- strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label);
- }
- if (mePtr->onValue == NULL) {
- mePtr->onValue = (char *) ckalloc((unsigned)
- (mePtr->labelLength + 1));
- strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label);
- }
-
- /*
- * Select the entry if the associated variable has the
- * appropriate value, initialize the variable if it doesn't
- * exist, then set a trace on the variable to monitor future
- * changes to its value.
- */
-
- value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY);
- mePtr->entryFlags &= ~ENTRY_SELECTED;
- if (value != NULL) {
- if (strcmp(value, mePtr->onValue) == 0) {
- mePtr->entryFlags |= ENTRY_SELECTED;
- }
- } else {
- Tcl_SetVar(menuPtr->interp, mePtr->name,
- (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "",
- TCL_GLOBAL_ONLY);
- }
- Tcl_TraceVar(menuPtr->interp, mePtr->name,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuVarProc, (ClientData) mePtr);
- }
-
/*
* Get the images for the entry, if there are any. Allocate the
* new images before freeing the old ones, so that the reference
* counts don't go to zero and cause image data to be discarded.
*/
- if (mePtr->imageString != NULL) {
- image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString,
+ if (mePtr->imagePtr != NULL) {
+ char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL);
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString,
TkMenuImageProc, (ClientData) mePtr);
if (image == NULL) {
return TCL_ERROR;
@@ -1588,8 +1750,10 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
Tk_FreeImage(mePtr->image);
}
mePtr->image = image;
- if (mePtr->selectImageString != NULL) {
- image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString,
+ if (mePtr->selectImagePtr != NULL) {
+ char *selectImageString = Tcl_GetStringFromObj(
+ mePtr->selectImagePtr, NULL);
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString,
TkMenuSelectImageProc, (ClientData) mePtr);
if (image == NULL) {
return TCL_ERROR;
@@ -1602,7 +1766,69 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
}
mePtr->selectImage = image;
- TkEventuallyRecomputeMenu(menuPtr);
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ Tcl_Obj *valuePtr;
+ char *name;
+
+ if (mePtr->namePtr == NULL) {
+ if (mePtr->labelPtr == NULL) {
+ mePtr->namePtr = NULL;
+ } else {
+ mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr);
+ Tcl_IncrRefCount(mePtr->namePtr);
+ }
+ }
+ if (mePtr->onValuePtr == NULL) {
+ if (mePtr->labelPtr == NULL) {
+ mePtr->onValuePtr = NULL;
+ } else {
+ mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr);
+ Tcl_IncrRefCount(mePtr->onValuePtr);
+ }
+ }
+
+ /*
+ * Select the entry if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't
+ * exist, then set a trace on the variable to monitor future
+ * changes to its value.
+ */
+
+ if (mePtr->namePtr != NULL) {
+ valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ } else {
+ valuePtr = NULL;
+ }
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if (valuePtr != NULL) {
+ if (mePtr->onValuePtr != NULL) {
+ char *value = Tcl_GetStringFromObj(valuePtr, NULL);
+ char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr,
+ NULL);
+
+
+ if (strcmp(value, onValue) == 0) {
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ }
+ }
+ } else {
+ if (mePtr->namePtr != NULL) {
+ Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL,
+ (mePtr->type == CHECK_BUTTON_ENTRY)
+ ? mePtr->offValuePtr
+ : Tcl_NewObj(),
+ TCL_GLOBAL_ONLY);
+ }
+ }
+ if (mePtr->namePtr != NULL) {
+ name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_TraceVar(menuPtr->interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+ }
return TCL_OK;
}
@@ -1610,13 +1836,78 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
/*
*----------------------------------------------------------------------
*
+ * ConfigureMenuEntry --
+ *
+ * This procedure is called to process an argv/argc list in order
+ * to configure (or reconfigure) one entry in a menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get
+ * set for mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuEntry(mePtr, objc, objv)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ Tk_SavedOptions errorStruct;
+ int result;
+
+ /*
+ * If this entry is a check button or radio button, then remove
+ * its old trace procedure.
+ */
+
+ if ((mePtr->namePtr != NULL)
+ && ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))) {
+ char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ Tcl_UntraceVar(menuPtr->interp, name,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, (ClientData) mePtr);
+ }
+
+ result = TCL_OK;
+ if (menuPtr->tkwin != NULL) {
+ if (Tk_SetOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, objc, objv, menuPtr->tkwin,
+ &errorStruct, (int *) NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ result = PostProcessEntry(mePtr);
+ if (result != TCL_OK) {
+ Tk_RestoreSavedOptions(&errorStruct);
+ PostProcessEntry(mePtr);
+ }
+ Tk_FreeSavedOptions(&errorStruct);
+ }
+
+ TkEventuallyRecomputeMenu(menuPtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ConfigureMenuCloneEntries --
*
* Calls ConfigureMenuEntry for each menu in the clone chain.
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information such as label and accelerator get
@@ -1626,22 +1917,21 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
*/
static int
-ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
+ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
TkMenu *menuPtr; /* Information about whole menu. */
int index; /* Index of mePtr within menuPtr's
* entries. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Additional flags to pass to
- * Tk_ConfigureWidget. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
{
TkMenuEntry *mePtr;
TkMenu *menuListPtr;
- char *oldCascadeName = NULL, *newMenuName = NULL;
- int cascadeEntryChanged;
+ int cascadeEntryChanged = 0;
TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL;
-
+ Tcl_Obj *oldCascadePtr = NULL;
+ char *newCascadeName;
+
/*
* Cascades are kind of tricky here. This is special case #3 in the comment
* at the top of this file. Basically, if a menu is the master menu of a
@@ -1653,21 +1943,47 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
mePtr = menuPtr->masterMenuPtr->entries[index];
if (mePtr->type == CASCADE_ENTRY) {
- oldCascadeName = mePtr->name;
+ oldCascadePtr = mePtr->namePtr;
+ if (oldCascadePtr != NULL) {
+ Tcl_IncrRefCount(oldCascadePtr);
+ }
}
- if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY)
- && (oldCascadeName != mePtr->name);
+ if (mePtr->type == CASCADE_ENTRY) {
+ char *oldCascadeName;
+
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ } else {
+ newCascadeName = NULL;
+ }
+
+ if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) {
+ cascadeEntryChanged = 0;
+ } else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL))
+ || ((oldCascadePtr != NULL)
+ && (mePtr->namePtr == NULL))) {
+ cascadeEntryChanged = 1;
+ } else {
+ oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr,
+ NULL);
+ cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName)
+ == 0);
+ }
+ if (oldCascadePtr != NULL) {
+ Tcl_DecrRefCount(oldCascadePtr);
+ }
+ }
if (cascadeEntryChanged) {
- newMenuName = mePtr->name;
- if (newMenuName != NULL) {
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
- mePtr->name);
+ newCascadeName);
}
}
@@ -1677,9 +1993,9 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
mePtr = menuListPtr->entries[index];
- if (cascadeEntryChanged && (mePtr->name != NULL)) {
- oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
- mePtr->name);
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ mePtr->namePtr);
if ((oldCascadeMenuRefPtr != NULL)
&& (oldCascadeMenuRefPtr->menuPtr != NULL)) {
@@ -1687,25 +2003,36 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
}
}
- if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if (cascadeEntryChanged && (newMenuName != NULL)) {
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
if (cascadeMenuRefPtr->menuPtr != NULL) {
- char *newArgV[2];
- char *newCloneName;
-
- newCloneName = TkNewMenuName(menuPtr->interp,
- Tk_PathName(menuListPtr->tkwin),
+ Tcl_Obj *newObjv[2];
+ Tcl_Obj *newCloneNamePtr;
+ Tcl_Obj *pathNamePtr = Tcl_NewStringObj(
+ Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1);
+
+ Tcl_IncrRefCount(pathNamePtr);
+ newCloneNamePtr = TkNewMenuName(menuPtr->interp,
+ pathNamePtr,
cascadeMenuRefPtr->menuPtr);
- CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName,
- "normal");
-
- newArgV[0] = "-menu";
- newArgV[1] = newCloneName;
- ConfigureMenuEntry(mePtr, 2, newArgV, flags);
- ckfree(newCloneName);
+ Tcl_IncrRefCount(newCloneNamePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr,
+ normalPtr);
+
+ newObjv[0] = menuObjPtr;
+ newObjv[1] = newCloneNamePtr;
+ Tcl_IncrRefCount(menuObjPtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCloneNamePtr);
+ Tcl_DecrRefCount(pathNamePtr);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(menuObjPtr);
}
}
}
@@ -1724,7 +2051,7 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
* A standard Tcl result. If all went well, then *indexPtr is
* filled in with the entry index corresponding to string
* (ranges from -1 to the number of entries in the menu minus
- * one). Otherwise an error message is left in interp->result.
+ * one). Otherwise an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -1733,38 +2060,39 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
*/
int
-TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
+TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr)
Tcl_Interp *interp; /* For error messages. */
TkMenu *menuPtr; /* Menu for which the index is being
* specified. */
- char *string; /* Specification of an entry in menu. See
+ Tcl_Obj *objPtr; /* Specification of an entry in menu. See
* manual entry for valid .*/
int lastOK; /* Non-zero means its OK to return index
* just *after* last entry. */
- int *indexPtr; /* Where to store converted relief. */
+ int *indexPtr; /* Where to store converted index. */
{
int i;
+ char *string = Tcl_GetStringFromObj(objPtr, NULL);
if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
*indexPtr = menuPtr->active;
- return TCL_OK;
+ goto success;
}
if (((string[0] == 'l') && (strcmp(string, "last") == 0))
|| ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
*indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
- return TCL_OK;
+ goto success;
}
if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
*indexPtr = -1;
- return TCL_OK;
+ goto success;
}
if (string[0] == '@') {
if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
== TCL_OK) {
- return TCL_OK;
+ goto success;
}
}
@@ -1780,25 +2108,29 @@ TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
i = -1;
}
*indexPtr = i;
- return TCL_OK;
+ goto success;
}
Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
}
for (i = 0; i < menuPtr->numEntries; i++) {
- char *label;
-
- label = menuPtr->entries[i]->label;
+ Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
+ char *label = (labelPtr == NULL) ? NULL
+ : Tcl_GetStringFromObj(labelPtr, NULL);
+
if ((label != NULL)
- && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) {
+ && (Tcl_StringMatch(label, string))) {
*indexPtr = i;
- return TCL_OK;
+ goto success;
}
}
Tcl_AppendResult(interp, "bad menu entry index \"",
string, "\"", (char *) NULL);
return TCL_ERROR;
+
+success:
+ return TCL_OK;
}
/*
@@ -1834,7 +2166,6 @@ MenuCmdDeletedProc(clientData)
*/
if (tkwin != NULL) {
- menuPtr->tkwin = NULL;
Tk_DestroyWindow(tkwin);
}
}
@@ -1890,41 +2221,49 @@ MenuNewEntry(menuPtr, index, type)
mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
menuPtr->entries[index] = mePtr;
mePtr->type = type;
+ mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type];
mePtr->menuPtr = menuPtr;
- mePtr->label = NULL;
+ mePtr->labelPtr = NULL;
mePtr->labelLength = 0;
mePtr->underline = -1;
- mePtr->bitmap = None;
- mePtr->imageString = NULL;
+ mePtr->bitmapPtr = NULL;
+ mePtr->imagePtr = NULL;
mePtr->image = NULL;
- mePtr->selectImageString = NULL;
+ mePtr->selectImagePtr = NULL;
mePtr->selectImage = NULL;
- mePtr->accel = NULL;
+ mePtr->accelPtr = NULL;
mePtr->accelLength = 0;
- mePtr->state = tkNormalUid;
- mePtr->border = NULL;
- mePtr->fg = NULL;
- mePtr->activeBorder = NULL;
- mePtr->activeFg = NULL;
- mePtr->tkfont = NULL;
- mePtr->indicatorOn = 1;
- mePtr->indicatorFg = NULL;
+ mePtr->state = ENTRY_DISABLED;
+ mePtr->borderPtr = NULL;
+ mePtr->fgPtr = NULL;
+ mePtr->activeBorderPtr = NULL;
+ mePtr->activeFgPtr = NULL;
+ mePtr->fontPtr = NULL;
+ mePtr->indicatorOn = 0;
+ mePtr->indicatorFgPtr = NULL;
mePtr->columnBreak = 0;
mePtr->hideMargin = 0;
- mePtr->command = NULL;
- mePtr->name = NULL;
+ mePtr->commandPtr = NULL;
+ mePtr->namePtr = NULL;
mePtr->childMenuRefPtr = NULL;
- mePtr->onValue = NULL;
- mePtr->offValue = NULL;
+ mePtr->onValuePtr = NULL;
+ mePtr->offValuePtr = NULL;
mePtr->entryFlags = 0;
mePtr->index = index;
mePtr->nextCascadePtr = NULL;
+ if (Tk_InitOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
+ ckfree((char *) mePtr);
+ return NULL;
+ }
TkMenuInitializeEntryDrawingFields(mePtr);
if (TkpMenuNewEntry(mePtr) != TCL_OK) {
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
+ menuPtr->tkwin);
ckfree((char *) mePtr);
return NULL;
}
-
+
return mePtr;
}
@@ -1946,25 +2285,24 @@ MenuNewEntry(menuPtr, index, type)
*/
static int
-MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
+MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
TkMenu *menuPtr; /* Widget in which to create new
* entry. */
- char *indexString; /* String describing index at which
+ Tcl_Obj *indexPtr; /* Object describing index at which
* to insert. NULL means insert at
* end. */
- int argc; /* Number of elements in argv. */
- char **argv; /* Arguments to command: first arg
+ int objc; /* Number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments to command: first arg
* is type of entry, others are
* config options. */
{
- int c, type, index;
- size_t length;
+ int type, index;
TkMenuEntry *mePtr;
TkMenu *menuListPtr;
- if (indexString != NULL) {
- if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index)
+ if (indexPtr != NULL) {
+ if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index)
!= TCL_OK) {
return TCL_ERROR;
}
@@ -1972,11 +2310,12 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
index = menuPtr->numEntries;
}
if (index < 0) {
+ char *indexString = Tcl_GetStringFromObj(indexPtr, NULL);
Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
(char *) NULL);
return TCL_ERROR;
}
- if (menuPtr->tearOff && (index == 0)) {
+ if (menuPtr->tearoff && (index == 0)) {
index = 1;
}
@@ -1984,30 +2323,11 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
* Figure out the type of the new entry.
*/
- c = argv[0][0];
- length = strlen(argv[0]);
- if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0)
- && (length >= 2)) {
- type = CASCADE_ENTRY;
- } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0)
- && (length >= 2)) {
- type = CHECK_BUTTON_ENTRY;
- } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0)
- && (length >= 2)) {
- type = COMMAND_ENTRY;
- } else if ((c == 'r')
- && (strncmp(argv[0], "radiobutton", length) == 0)) {
- type = RADIO_BUTTON_ENTRY;
- } else if ((c == 's')
- && (strncmp(argv[0], "separator", length) == 0)) {
- type = SEPARATOR_ENTRY;
- } else {
- Tcl_AppendResult(interp, "bad menu entry type \"",
- argv[0], "\": must be cascade, checkbutton, ",
- "command, radiobutton, or separator", (char *) NULL);
+ if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings,
+ "menu entry type", 0, &type) != TCL_OK) {
return TCL_ERROR;
}
-
+
/*
* Now we have to add an entry for every instance related to this menu.
*/
@@ -2019,9 +2339,9 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
if (mePtr == NULL) {
return TCL_ERROR;
}
- if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
TkMenu *errorMenuPtr;
- int i;
+ int i;
for (errorMenuPtr = menuPtr->masterMenuPtr;
errorMenuPtr != NULL;
@@ -2054,28 +2374,40 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
*/
if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {
- if ((mePtr->name != NULL) && (mePtr->childMenuRefPtr != NULL)
+ if ((mePtr->namePtr != NULL)
+ && (mePtr->childMenuRefPtr != NULL)
&& (mePtr->childMenuRefPtr->menuPtr != NULL)) {
TkMenu *cascadeMenuPtr =
mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
- char *newCascadeName;
- char *newArgv[2];
+ Tcl_Obj *newCascadePtr;
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *newObjv[2];
TkMenuReferences *menuRefPtr;
-
- newCascadeName = TkNewMenuName(menuListPtr->interp,
- Tk_PathName(menuListPtr->tkwin),
- cascadeMenuPtr);
- CloneMenu(cascadeMenuPtr, newCascadeName, "normal");
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuListPtr->interp,
+ windowNamePtr, cascadeMenuPtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
- menuRefPtr = TkFindMenuReferences(menuListPtr->interp,
- newCascadeName);
+ menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
+ newCascadePtr);
if (menuRefPtr == NULL) {
panic("CloneMenu failed inside of MenuAddOrInsert.");
}
- newArgv[0] = "-menu";
- newArgv[1] = newCascadeName;
- ConfigureMenuEntry(mePtr, 2, newArgv, 0);
- ckfree(newCascadeName);
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(menuNamePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(menuNamePtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ Tcl_DecrRefCount(normalPtr);
}
}
}
@@ -2112,6 +2444,8 @@ MenuVarProc(clientData, interp, name1, name2, flags)
TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
TkMenu *menuPtr;
char *value;
+ char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ char *onValue;
menuPtr = mePtr->menuPtr;
@@ -2123,7 +2457,7 @@ MenuVarProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
mePtr->entryFlags &= ~ENTRY_SELECTED;
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
- Tcl_TraceVar(interp, mePtr->name,
+ Tcl_TraceVar(interp, name,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuVarProc, clientData);
}
@@ -2137,17 +2471,22 @@ MenuVarProc(clientData, interp, name1, name2, flags)
* the menu entry.
*/
- value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY);
+ value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY);
if (value == NULL) {
value = "";
}
- if (strcmp(value, mePtr->onValue) == 0) {
- if (mePtr->entryFlags & ENTRY_SELECTED) {
+ if (mePtr->onValuePtr != NULL) {
+ onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL);
+ if (strcmp(value, onValue) == 0) {
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ return (char *) NULL;
+ }
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ } else if (mePtr->entryFlags & ENTRY_SELECTED) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ } else {
return (char *) NULL;
}
- mePtr->entryFlags |= ENTRY_SELECTED;
- } else if (mePtr->entryFlags & ENTRY_SELECTED) {
- mePtr->entryFlags &= ~ENTRY_SELECTED;
} else {
return (char *) NULL;
}
@@ -2193,15 +2532,15 @@ TkActivateMenuEntry(menuPtr, index)
* might already have been changed to disabled).
*/
- if (mePtr->state == tkActiveUid) {
- mePtr->state = tkNormalUid;
+ if (mePtr->state == ENTRY_ACTIVE) {
+ mePtr->state = ENTRY_NORMAL;
}
TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
}
menuPtr->active = index;
if (index >= 0) {
mePtr = menuPtr->entries[index];
- mePtr->state = tkActiveUid;
+ mePtr->state = ENTRY_ACTIVE;
TkEventuallyRedrawMenu(menuPtr, mePtr);
}
return result;
@@ -2237,9 +2576,13 @@ TkPostCommand(menuPtr)
* the menu's geometry if needed.
*/
- if (menuPtr->postCommand != NULL) {
- result = TkCopyAndGlobalEval(menuPtr->interp,
- menuPtr->postCommand);
+ if (menuPtr->postCommandPtr != NULL) {
+ Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr;
+
+ Tcl_IncrRefCount(postCommandPtr);
+ result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr,
+ TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(postCommandPtr);
if (result != TCL_OK) {
return result;
}
@@ -2269,64 +2612,53 @@ TkPostCommand(menuPtr)
*/
static int
-CloneMenu(menuPtr, newMenuName, newMenuTypeString)
+CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr)
TkMenu *menuPtr; /* The menu we are going to clone */
- char *newMenuName; /* The name to give the new menu */
- char *newMenuTypeString; /* What kind of menu is this, a normal menu
+ Tcl_Obj *newMenuNamePtr; /* The name to give the new menu */
+ Tcl_Obj *newMenuTypePtr; /* What kind of menu is this, a normal menu
* a menubar, or a tearoff? */
{
int returnResult;
- int menuType;
- size_t length;
+ int menuType, i;
TkMenuReferences *menuRefPtr;
- Tcl_Obj *commandObjPtr;
+ Tcl_Obj *menuDupCommandArray[4];
- if (newMenuTypeString == NULL) {
+ if (newMenuTypePtr == NULL) {
menuType = MASTER_MENU;
} else {
- length = strlen(newMenuTypeString);
- if (strncmp(newMenuTypeString, "normal", length) == 0) {
- menuType = MASTER_MENU;
- } else if (strncmp(newMenuTypeString, "tearoff", length) == 0) {
- menuType = TEAROFF_MENU;
- } else if (strncmp(newMenuTypeString, "menubar", length) == 0) {
- menuType = MENUBAR;
- } else {
- Tcl_AppendResult(menuPtr->interp,
- "bad menu type - must be normal, tearoff, or menubar",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr,
+ menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
- commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj("tkMenuDup", -1));
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1));
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(newMenuName, -1));
- if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) {
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj("normal", -1));
+ menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1);
+ menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ menuDupCommandArray[2] = newMenuNamePtr;
+ if (newMenuTypePtr == NULL) {
+ menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
} else {
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(newMenuTypeString, -1));
+ menuDupCommandArray[3] = newMenuTypePtr;
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_IncrRefCount(menuDupCommandArray[i]);
}
- Tcl_IncrRefCount(commandObjPtr);
Tcl_Preserve((ClientData) menuPtr);
- returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr);
- Tcl_DecrRefCount(commandObjPtr);
+ returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0);
+ for (i = 0; i < 4; i++) {
+ Tcl_DecrRefCount(menuDupCommandArray[i]);
+ }
/*
* Make sure the tcl command actually created the clone.
*/
if ((returnResult == TCL_OK) &&
- ((menuRefPtr = TkFindMenuReferences(menuPtr->interp, newMenuName))
- != (TkMenuReferences *) NULL)
+ ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ newMenuNamePtr)) != (TkMenuReferences *) NULL)
&& (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
TkMenu *newMenuPtr = menuRefPtr->menuPtr;
+ Tcl_Obj *newObjv[3];
char *newArgv[3];
int i, numElements;
@@ -2359,8 +2691,8 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
newMenuPtr->interp, 2, newArgv) == TCL_OK) {
char *windowName;
- Tcl_Obj *bindingsPtr =
- Tcl_NewStringObj(newMenuPtr->interp->result, -1);
+ Tcl_Obj *bindingsPtr =
+ Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
Tcl_Obj *elementPtr;
Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
@@ -2372,11 +2704,12 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
== 0) {
Tcl_Obj *newElementPtr = Tcl_NewStringObj(
Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newElementPtr);
Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
i + 1, 0, 1, &newElementPtr);
newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
- Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
- menuPtr->interp, 3, newArgv);
+ Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
+ menuPtr->interp, 3, newArgv);
break;
}
}
@@ -2389,30 +2722,35 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
*/
for (i = 0; i < menuPtr->numEntries; i++) {
- char *newCascadeName;
TkMenuReferences *cascadeRefPtr;
TkMenu *oldCascadePtr;
if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
- && (menuPtr->entries[i]->name != NULL)) {
+ && (menuPtr->entries[i]->namePtr != NULL)) {
cascadeRefPtr =
- TkFindMenuReferences(menuPtr->interp,
- menuPtr->entries[i]->name);
+ TkFindMenuReferencesObj(menuPtr->interp,
+ menuPtr->entries[i]->namePtr);
if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
- char *nameString;
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
+ -1);
+ Tcl_Obj *newCascadePtr;
oldCascadePtr = cascadeRefPtr->menuPtr;
- nameString = Tk_PathName(newMenuPtr->tkwin);
- newCascadeName = TkNewMenuName(menuPtr->interp,
- nameString, oldCascadePtr);
- CloneMenu(oldCascadePtr, newCascadeName, NULL);
-
- newArgv[0] = "-menu";
- newArgv[1] = newCascadeName;
- ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
- ckfree(newCascadeName);
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuPtr->interp,
+ windowNamePtr, oldCascadePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ CloneMenu(oldCascadePtr, newCascadePtr, NULL);
+
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(windowNamePtr);
}
}
}
@@ -2442,22 +2780,24 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
*/
static int
-MenuDoYPosition(interp, menuPtr, arg)
+MenuDoYPosition(interp, menuPtr, objPtr)
Tcl_Interp *interp;
TkMenu *menuPtr;
- char *arg;
+ Tcl_Obj *objPtr;
{
int index;
TkRecomputeMenu(menuPtr);
- if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) {
+ if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
goto error;
}
+ Tcl_ResetResult(interp);
if (index < 0) {
- interp->result = "0";
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
} else {
- sprintf(interp->result, "%d", menuPtr->entries[index]->y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
}
+
return TCL_OK;
error:
@@ -2507,7 +2847,8 @@ GetIndexFromCoords(interp, menuPtr, string, indexPtr)
goto error;
}
} else {
- x = menuPtr->borderWidth;
+ Tk_GetPixelsFromObj(interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &x);
}
for (i = 0; i < menuPtr->numEntries; i++) {
@@ -2583,65 +2924,66 @@ RecursivelyDeleteMenu(menuPtr)
*----------------------------------------------------------------------
*/
-char *
-TkNewMenuName(interp, parentName, menuPtr)
+Tcl_Obj *
+TkNewMenuName(interp, parentPtr, menuPtr)
Tcl_Interp *interp; /* The interp the new name has to live in.*/
- char *parentName; /* The prefix path of the new name. */
+ Tcl_Obj *parentPtr; /* The prefix path of the new name. */
TkMenu *menuPtr; /* The menu we are cloning. */
{
- Tcl_DString resultDString;
- Tcl_DString childDString;
+ Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent
+ * compiler warning. */
+ Tcl_Obj *childPtr;
char *destString;
- int offset, i;
- int doDot = parentName[strlen(parentName) - 1] != '.';
+ int i;
+ int doDot;
Tcl_CmdInfo cmdInfo;
- char *returnString;
Tcl_HashTable *nameTablePtr = NULL;
TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
+ char *parentName = Tcl_GetStringFromObj(parentPtr, NULL);
+
if (winPtr->mainPtr != NULL) {
nameTablePtr = &(winPtr->mainPtr->nameTable);
}
-
- Tcl_DStringInit(&childDString);
- Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1);
- for (destString = Tcl_DStringValue(&childDString);
+
+ doDot = parentName[strlen(parentName) - 1] != '.';
+
+ childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ for (destString = Tcl_GetStringFromObj(childPtr, NULL);
*destString != '\0'; destString++) {
if (*destString == '.') {
*destString = '#';
}
}
- offset = 0;
-
for (i = 0; ; i++) {
if (i == 0) {
- Tcl_DStringInit(&resultDString);
- Tcl_DStringAppend(&resultDString, parentName, -1);
+ resultPtr = Tcl_DuplicateObj(parentPtr);
if (doDot) {
- Tcl_DStringAppend(&resultDString, ".", -1);
+ Tcl_AppendToObj(resultPtr, ".", -1);
}
- Tcl_DStringAppend(&resultDString,
- Tcl_DStringValue(&childDString), -1);
- destString = Tcl_DStringValue(&resultDString);
+ Tcl_AppendObjToObj(resultPtr, childPtr);
} else {
- if (i == 1) {
- offset = Tcl_DStringLength(&resultDString);
- Tcl_DStringSetLength(&resultDString, offset + 10);
- destString = Tcl_DStringValue(&resultDString);
- }
- sprintf(destString + offset, "%d", i);
+ Tcl_Obj *intPtr;
+
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = Tcl_DuplicateObj(parentPtr);
+ if (doDot) {
+ Tcl_AppendToObj(resultPtr, ".", -1);
+ }
+ Tcl_AppendObjToObj(resultPtr, childPtr);
+ intPtr = Tcl_NewIntObj(i);
+ Tcl_AppendObjToObj(resultPtr, intPtr);
+ Tcl_DecrRefCount(intPtr);
}
+ destString = Tcl_GetStringFromObj(resultPtr, NULL);
if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
&& ((nameTablePtr == NULL)
|| (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
break;
}
}
- returnString = ckalloc(strlen(destString) + 1);
- strcpy(returnString, destString);
- Tcl_DStringFree(&resultDString);
- Tcl_DStringFree(&childDString);
- return returnString;
+ Tcl_DecrRefCount(childPtr);
+ return resultPtr;
}
/*
@@ -2756,32 +3098,45 @@ TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
menuPtr = menuRefPtr->menuPtr;
if (menuPtr != NULL) {
- char *cloneMenuName;
+ Tcl_Obj *cloneMenuPtr;
TkMenuReferences *cloneMenuRefPtr;
- char *newArgv[4];
+ Tcl_Obj *newObjv[4];
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin),
+ -1);
+ Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1);
/*
* Clone the menu and all of the cascades underneath it.
*/
- cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin),
+ Tcl_IncrRefCount(windowNamePtr);
+ cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
menuPtr);
- CloneMenu(menuPtr, cloneMenuName, "menubar");
+ Tcl_IncrRefCount(cloneMenuPtr);
+ Tcl_IncrRefCount(menubarPtr);
+ CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
- cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName);
+ cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr);
if ((cloneMenuRefPtr != NULL)
&& (cloneMenuRefPtr->menuPtr != NULL)) {
+ Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1);
+ Tcl_Obj *nullPtr = Tcl_NewObj();
cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
menuBarPtr = cloneMenuRefPtr->menuPtr;
- newArgv[0] = "-cursor";
- newArgv[1] = "";
+ newObjv[0] = cursorPtr;
+ newObjv[1] = nullPtr;
+ Tcl_IncrRefCount(cursorPtr);
+ Tcl_IncrRefCount(nullPtr);
ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
- 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ 2, newObjv);
+ Tcl_DecrRefCount(cursorPtr);
+ Tcl_DecrRefCount(nullPtr);
}
TkpSetWindowMenuBar(tkwin, menuBarPtr);
-
- ckfree(cloneMenuName);
+ Tcl_DecrRefCount(cloneMenuPtr);
+ Tcl_DecrRefCount(menubarPtr);
+ Tcl_DecrRefCount(windowNamePtr);
} else {
TkpSetWindowMenuBar(tkwin, NULL);
}
@@ -2948,6 +3303,35 @@ TkFindMenuReferences(interp, pathName)
/*
*----------------------------------------------------------------------
*
+ * TkFindMenuReferencesObj --
+ *
+ * Given a pathname, gives back a pointer to the TkMenuReferences
+ * structure.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not
+ * be freed by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called. Returns NULL if no reference
+ * with this pathname exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkFindMenuReferencesObj(interp, objPtr)
+ Tcl_Interp *interp; /* The interp the menu is living in. */
+ Tcl_Obj *objPtr; /* The path of the menu widget */
+{
+ char *pathName = Tcl_GetStringFromObj(objPtr, NULL);
+ return TkFindMenuReferences(interp, pathName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkFreeMenuReferences --
*
* This is called after one of the fields in a menu reference
@@ -3050,8 +3434,19 @@ DeleteMenuCloneEntries(menuPtr, first, last)
void
TkMenuInit()
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
if (!menusInitialized) {
- TkpMenuInit();
- menusInitialized = 1;
+ Tcl_MutexLock(&menuMutex);
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+ Tcl_MutexUnlock(&menuMutex);
+ }
+ if (!tsdPtr->menusInitialized) {
+ TkpMenuThreadInit();
+ tsdPtr->menusInitialized = 1;
}
}