diff options
Diffstat (limited to 'generic/tkMenu.c')
| -rw-r--r-- | generic/tkMenu.c | 2209 |
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; } } |