X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0bd508417142ff377f34aec8dcec9438d9175c2c..6303aba12277fcac6a597908fb047560cf7c0c3e:/src/w32menu.c
diff --git a/src/w32menu.c b/src/w32menu.c
index c570385c3b..0ed9bffe70 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1,13 +1,14 @@
/* Menu support for GNU Emacs on the Microsoft W32 API.
Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -15,15 +16,14 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see . */
#include
#include
#include
#include
+#include
#include "lisp.h"
#include "keyboard.h"
@@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA. */
#include "charset.h"
#include "character.h"
#include "coding.h"
+#include "menu.h"
/* This may include sys/types.h, and that somehow loses
if this is not done before the other system files. */
@@ -51,82 +52,6 @@ Boston, MA 02110-1301, USA. */
#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
-/******************************************************************/
-/* Definitions copied from lwlib.h */
-
-typedef void * XtPointer;
-typedef char Boolean;
-
-enum button_type
-{
- BUTTON_TYPE_NONE,
- BUTTON_TYPE_TOGGLE,
- BUTTON_TYPE_RADIO
-};
-
-/* This structure is based on the one in ../lwlib/lwlib.h, modified
- for Windows. */
-typedef struct _widget_value
-{
- /* name of widget */
- Lisp_Object lname;
- char* name;
- /* value (meaning depend on widget type) */
- char* value;
- /* keyboard equivalent. no implications for XtTranslations */
- Lisp_Object lkey;
- char* key;
- /* Help string or nil if none.
- GC finds this string through the frame's menu_bar_vector
- or through menu_items. */
- Lisp_Object help;
- /* true if enabled */
- Boolean enabled;
- /* true if selected */
- Boolean selected;
- /* The type of a button. */
- enum button_type button_type;
- /* true if menu title */
- Boolean title;
-#if 0
- /* true if was edited (maintained by get_value) */
- Boolean edited;
- /* true if has changed (maintained by lw library) */
- change_type change;
- /* true if this widget itself has changed,
- but not counting the other widgets found in the `next' field. */
- change_type this_one_change;
-#endif
- /* Contents of the sub-widgets, also selected slot for checkbox */
- struct _widget_value* contents;
- /* data passed to callback */
- XtPointer call_data;
- /* next one in the list */
- struct _widget_value* next;
-#if 0
- /* slot for the toolkit dependent part. Always initialize to NULL. */
- void* toolkit_data;
- /* tell us if we should free the toolkit data slot when freeing the
- widget_value itself. */
- Boolean free_toolkit_data;
-
- /* we resource the widget_value structures; this points to the next
- one on the free list if this one has been deallocated.
- */
- struct _widget_value *free_list;
-#endif
-} widget_value;
-
-/* Local memory management */
-#define local_heap (GetProcessHeap ())
-#define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
-#define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
-
-#define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
-#define free_widget_value(wv) (local_free ((wv)))
-
-/******************************************************************/
-
#ifndef TRUE
#define TRUE 1
#define FALSE 0
@@ -134,8 +59,8 @@ typedef struct _widget_value
HMENU current_popup_menu;
-void syms_of_w32menu ();
-void globals_of_w32menu ();
+void syms_of_w32menu (void);
+void globals_of_w32menu (void);
typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
IN HMENU,
@@ -147,15 +72,19 @@ typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
IN UINT,
IN BOOL,
IN LPCMENUITEMINFOA);
+typedef int (WINAPI * MessageBoxW_Proc) (
+ IN HWND window,
+ IN WCHAR *text,
+ IN WCHAR *caption,
+ IN UINT type);
GetMenuItemInfoA_Proc get_menu_item_info = NULL;
SetMenuItemInfoA_Proc set_menu_item_info = NULL;
AppendMenuW_Proc unicode_append_menu = NULL;
+MessageBoxW_Proc unicode_message_box = NULL;
Lisp_Object Qdebug_on_next_call;
-extern Lisp_Object Vmenu_updating_frame;
-
extern Lisp_Object Qmenu_bar;
extern Lisp_Object QCtoggle, QCradio;
@@ -167,78 +96,19 @@ extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
extern Lisp_Object Qmenu_bar_update_hook;
-void set_frame_menubar ();
+void set_frame_menubar (FRAME_PTR, int, int);
-static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object));
#ifdef HAVE_DIALOGS
-static Lisp_Object w32_dialog_show ();
+static Lisp_Object w32_dialog_show (FRAME_PTR, int, Lisp_Object, char**);
+#else
+static int is_simple_dialog (Lisp_Object);
+static Lisp_Object simple_dialog_show (FRAME_PTR, Lisp_Object, Lisp_Object);
#endif
-static Lisp_Object w32_menu_show ();
-static void keymap_panes ();
-static void single_keymap_panes ();
-static void single_menu_item ();
-static void list_of_panes ();
-static void list_of_items ();
+static void utf8to16 (unsigned char *, int, WCHAR *);
+
void w32_free_menu_strings (HWND);
-/* This holds a Lisp vector that holds the results of decoding
- the keymaps or alist-of-alists that specify a menu.
-
- It describes the panes and items within the panes.
-
- Each pane is described by 3 elements in the vector:
- t, the pane name, the pane's prefix key.
- Then follow the pane's items, with 5 elements per item:
- the item string, the enable flag, the item's value,
- the definition, and the equivalent keyboard key's description string.
-
- In some cases, multiple levels of menus may be described.
- A single vector slot containing nil indicates the start of a submenu.
- A single vector slot containing lambda indicates the end of a submenu.
- The submenu follows a menu item which is the way to reach the submenu.
-
- A single vector slot containing quote indicates that the
- following items should appear on the right of a dialog box.
-
- Using a Lisp vector to hold this information while we decode it
- takes care of protecting all the data from GC. */
-
-#define MENU_ITEMS_PANE_NAME 1
-#define MENU_ITEMS_PANE_PREFIX 2
-#define MENU_ITEMS_PANE_LENGTH 3
-
-enum menu_item_idx
-{
- MENU_ITEMS_ITEM_NAME = 0,
- MENU_ITEMS_ITEM_ENABLE,
- MENU_ITEMS_ITEM_VALUE,
- MENU_ITEMS_ITEM_EQUIV_KEY,
- MENU_ITEMS_ITEM_DEFINITION,
- MENU_ITEMS_ITEM_TYPE,
- MENU_ITEMS_ITEM_SELECTED,
- MENU_ITEMS_ITEM_HELP,
- MENU_ITEMS_ITEM_LENGTH
-};
-
-static Lisp_Object menu_items;
-
-/* Number of slots currently allocated in menu_items. */
-static int menu_items_allocated;
-
-/* This is the index in menu_items of the first empty slot. */
-static int menu_items_used;
-
-/* The number of panes currently recorded in menu_items,
- excluding those within submenus. */
-static int menu_items_n_panes;
-
-/* Current depth within submenus. */
-static int menu_items_submenu_depth;
-
-static int next_menubar_widget_id;
/* This is set nonzero after the user activates the menu bar, and set
to zero again after the menu bars are redisplayed by prepare_menu_bar.
@@ -249,598 +119,6 @@ static int next_menubar_widget_id;
int pending_menu_activation;
-
-/* Return the frame whose ->output_data.w32->menubar_widget equals
- ID, or 0 if none. */
-
-static struct frame *
-menubar_id_to_frame (id)
- HMENU id;
-{
- Lisp_Object tail, frame;
- FRAME_PTR f;
-
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
- f = XFRAME (frame);
- if (!FRAME_WINDOW_P (f))
- continue;
- if (f->output_data.w32->menubar_widget == id)
- return f;
- }
- return 0;
-}
-
-/* Initialize the menu_items structure if we haven't already done so.
- Also mark it as currently empty. */
-
-static void
-init_menu_items ()
-{
- if (NILP (menu_items))
- {
- menu_items_allocated = 60;
- menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
- }
-
- menu_items_used = 0;
- menu_items_n_panes = 0;
- menu_items_submenu_depth = 0;
-}
-
-/* Call at the end of generating the data in menu_items.
- This fills in the number of items in the last pane. */
-
-static void
-finish_menu_items ()
-{
-}
-
-/* Call when finished using the data for the current menu
- in menu_items. */
-
-static void
-discard_menu_items ()
-{
- /* Free the structure if it is especially large.
- Otherwise, hold on to it, to save time. */
- if (menu_items_allocated > 200)
- {
- menu_items = Qnil;
- menu_items_allocated = 0;
- }
-}
-
-/* Make the menu_items vector twice as large. */
-
-static void
-grow_menu_items ()
-{
- menu_items_allocated *= 2;
- menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
-}
-
-/* Begin a submenu. */
-
-static void
-push_submenu_start ()
-{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- ASET (menu_items, menu_items_used++, Qnil);
- menu_items_submenu_depth++;
-}
-
-/* End a submenu. */
-
-static void
-push_submenu_end ()
-{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- ASET (menu_items, menu_items_used++, Qlambda);
- menu_items_submenu_depth--;
-}
-
-/* Indicate boundary between left and right. */
-
-static void
-push_left_right_boundary ()
-{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- ASET (menu_items, menu_items_used++, Qquote);
-}
-
-/* Start a new menu pane in menu_items.
- NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
-
-static void
-push_menu_pane (name, prefix_vec)
- Lisp_Object name, prefix_vec;
-{
- if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
- grow_menu_items ();
-
- if (menu_items_submenu_depth == 0)
- menu_items_n_panes++;
- ASET (menu_items, menu_items_used++, Qt);
- ASET (menu_items, menu_items_used++, name);
- ASET (menu_items, menu_items_used++, prefix_vec);
-}
-
-/* Push one menu item into the current pane. NAME is the string to
- display. ENABLE if non-nil means this item can be selected. KEY
- is the key generated by choosing this item, or nil if this item
- doesn't really have a definition. DEF is the definition of this
- item. EQUIV is the textual description of the keyboard equivalent
- for this item (or nil if none). TYPE is the type of this menu
- item, one of nil, `toggle' or `radio'. */
-
-static void
-push_menu_item (name, enable, key, def, equiv, type, selected, help)
- Lisp_Object name, enable, key, def, equiv, type, selected, help;
-{
- if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
- grow_menu_items ();
-
- ASET (menu_items, menu_items_used++, name);
- ASET (menu_items, menu_items_used++, enable);
- ASET (menu_items, menu_items_used++, key);
- ASET (menu_items, menu_items_used++, equiv);
- ASET (menu_items, menu_items_used++, def);
- ASET (menu_items, menu_items_used++, type);
- ASET (menu_items, menu_items_used++, selected);
- ASET (menu_items, menu_items_used++, help);
-}
-
-/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
- and generate menu panes for them in menu_items.
- If NOTREAL is nonzero,
- don't bother really computing whether an item is enabled. */
-
-static void
-keymap_panes (keymaps, nmaps, notreal)
- Lisp_Object *keymaps;
- int nmaps;
- int notreal;
-{
- int mapno;
-
- init_menu_items ();
-
- /* Loop over the given keymaps, making a pane for each map.
- But don't make a pane that is empty--ignore that map instead.
- P is the number of panes we have made so far. */
- for (mapno = 0; mapno < nmaps; mapno++)
- single_keymap_panes (keymaps[mapno],
- Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
-
- finish_menu_items ();
-}
-
-/* This is a recursive subroutine of keymap_panes.
- It handles one keymap, KEYMAP.
- The other arguments are passed along
- or point to local variables of the previous function.
- If NOTREAL is nonzero, only check for equivalent key bindings, don't
- evaluate expressions in menu items and don't make any menu.
-
- If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
-
-static void
-single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
- Lisp_Object keymap;
- Lisp_Object pane_name;
- Lisp_Object prefix;
- int notreal;
- int maxdepth;
-{
- Lisp_Object pending_maps = Qnil;
- Lisp_Object tail, item;
- struct gcpro gcpro1, gcpro2;
-
- if (maxdepth <= 0)
- return;
-
- push_menu_pane (pane_name, prefix);
-
- for (tail = keymap; CONSP (tail); tail = XCDR (tail))
- {
- GCPRO2 (keymap, pending_maps);
- /* Look at each key binding, and if it is a menu item add it
- to this menu. */
- item = XCAR (tail);
- if (CONSP (item))
- single_menu_item (XCAR (item), XCDR (item),
- &pending_maps, notreal, maxdepth);
- else if (VECTORP (item))
- {
- /* Loop over the char values represented in the vector. */
- int len = ASIZE (item);
- int c;
- for (c = 0; c < len; c++)
- {
- Lisp_Object character;
- XSETFASTINT (character, c);
- single_menu_item (character, AREF (item, c),
- &pending_maps, notreal, maxdepth);
- }
- }
- UNGCPRO;
- }
-
- /* Process now any submenus which want to be panes at this level. */
- while (!NILP (pending_maps))
- {
- Lisp_Object elt, eltcdr, string;
- elt = Fcar (pending_maps);
- eltcdr = XCDR (elt);
- string = XCAR (eltcdr);
- /* We no longer discard the @ from the beginning of the string here.
- Instead, we do this in w32_menu_show. */
- single_keymap_panes (Fcar (elt), string,
- XCDR (eltcdr), notreal, maxdepth - 1);
- pending_maps = Fcdr (pending_maps);
- }
-}
-
-/* This is a subroutine of single_keymap_panes that handles one
- keymap entry.
- KEY is a key in a keymap and ITEM is its binding.
- PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
- separate panes.
- If NOTREAL is nonzero, only check for equivalent key bindings, don't
- evaluate expressions in menu items and don't make any menu.
- If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
-
-static void
-single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
- Lisp_Object key, item;
- Lisp_Object *pending_maps_ptr;
- int maxdepth, notreal;
-{
- Lisp_Object map, item_string, enabled;
- struct gcpro gcpro1, gcpro2;
- int res;
-
- /* Parse the menu item and leave the result in item_properties. */
- GCPRO2 (key, item);
- res = parse_menu_item (item, notreal, 0);
- UNGCPRO;
- if (!res)
- return; /* Not a menu item. */
-
- map = AREF (item_properties, ITEM_PROPERTY_MAP);
-
- if (notreal)
- {
- /* We don't want to make a menu, just traverse the keymaps to
- precompute equivalent key bindings. */
- if (!NILP (map))
- single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
- return;
- }
-
- enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
- item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
-
- if (!NILP (map) && SREF (item_string, 0) == '@')
- {
- if (!NILP (enabled))
- /* An enabled separate pane. Remember this to handle it later. */
- *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
- *pending_maps_ptr);
- return;
- }
-
- push_menu_item (item_string, enabled, key,
- AREF (item_properties, ITEM_PROPERTY_DEF),
- AREF (item_properties, ITEM_PROPERTY_KEYEQ),
- AREF (item_properties, ITEM_PROPERTY_TYPE),
- AREF (item_properties, ITEM_PROPERTY_SELECTED),
- AREF (item_properties, ITEM_PROPERTY_HELP));
-
- /* Display a submenu using the toolkit. */
- if (! (NILP (map) || NILP (enabled)))
- {
- push_submenu_start ();
- single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
- push_submenu_end ();
- }
-}
-
-/* Push all the panes and items of a menu described by the
- alist-of-alists MENU.
- This handles old-fashioned calls to x-popup-menu. */
-
-static void
-list_of_panes (menu)
- Lisp_Object menu;
-{
- Lisp_Object tail;
-
- init_menu_items ();
-
- for (tail = menu; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object elt, pane_name, pane_data;
- elt = XCAR (tail);
- pane_name = Fcar (elt);
- CHECK_STRING (pane_name);
- push_menu_pane (pane_name, Qnil);
- pane_data = Fcdr (elt);
- CHECK_CONS (pane_data);
- list_of_items (pane_data);
- }
-
- finish_menu_items ();
-}
-
-/* Push the items in a single pane defined by the alist PANE. */
-
-static void
-list_of_items (pane)
- Lisp_Object pane;
-{
- Lisp_Object tail, item, item1;
-
- for (tail = pane; CONSP (tail); tail = XCDR (tail))
- {
- item = XCAR (tail);
- if (STRINGP (item))
- push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
- else if (NILP (item))
- push_left_right_boundary ();
- else
- {
- CHECK_CONS (item);
- item1 = Fcar (item);
- CHECK_STRING (item1);
- push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
- }
- }
-}
-
-DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
- doc: /* Pop up a deck-of-cards menu and return user's selection.
-POSITION is a position specification. This is either a mouse button
-event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
-are positions in pixels from the top left corner of WINDOW's frame
-\(WINDOW may be a frame object instead of a window). This controls the
-position of the center of the first line in the first pane of the
-menu, not the top left of the menu as a whole. If POSITION is t, it
-means to use the current mouse position.
-
-MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
-The menu items come from key bindings that have a menu string as well as
-a definition; actually, the \"definition\" in such a key binding looks like
-\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
-the keymap as a top-level element.
-
-If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
-Otherwise, REAL-DEFINITION should be a valid key binding definition.
-
-You can also use a list of keymaps as MENU. Then each keymap makes a
-separate pane. When MENU is a keymap or a list of keymaps, the return
-value is a list of events.
-
-Alternatively, you can specify a menu of multiple panes with a list of
-the form (TITLE PANE1 PANE2...), where each pane is a list of
-form (TITLE ITEM1 ITEM2...).
-Each ITEM is normally a cons cell (STRING . VALUE); but a string can
-appear as an item--that makes a nonselectable line in the menu.
-With this form of menu, the return value is VALUE from the chosen item.
-
-If POSITION is nil, don't display the menu at all, just precalculate the
-cached information about equivalent key sequences. */)
- (position, menu)
- Lisp_Object position, menu;
-{
- Lisp_Object keymap, tem;
- int xpos = 0, ypos = 0;
- Lisp_Object title;
- char *error_name;
- Lisp_Object selection;
- FRAME_PTR f = NULL;
- Lisp_Object x, y, window;
- int keymaps = 0;
- int for_click = 0;
- struct gcpro gcpro1;
-
-#ifdef HAVE_MENUS
- if (! NILP (position))
- {
- check_w32 ();
-
- /* Decode the first argument: find the window and the coordinates. */
- if (EQ (position, Qt)
- || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
- || EQ (XCAR (position), Qtool_bar))))
- {
- /* Use the mouse's current position. */
- FRAME_PTR new_f = SELECTED_FRAME ();
- Lisp_Object bar_window;
- enum scroll_bar_part part;
- unsigned long time;
-
- if (FRAME_TERMINAL (new_f)->mouse_position_hook)
- (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
- &part, &x, &y, &time);
- if (new_f != 0)
- XSETFRAME (window, new_f);
- else
- {
- window = selected_window;
- XSETFASTINT (x, 0);
- XSETFASTINT (y, 0);
- }
- }
- else
- {
- tem = Fcar (position);
- if (CONSP (tem))
- {
- window = Fcar (Fcdr (position));
- x = Fcar (tem);
- y = Fcar (Fcdr (tem));
- }
- else
- {
- for_click = 1;
- tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
- window = Fcar (tem); /* POSN_WINDOW (tem) */
- tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
- x = Fcar (tem);
- y = Fcdr (tem);
- }
- }
-
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
-
- /* Decode where to put the menu. */
-
- if (FRAMEP (window))
- {
- f = XFRAME (window);
- xpos = 0;
- ypos = 0;
- }
- else if (WINDOWP (window))
- {
- CHECK_LIVE_WINDOW (window);
- f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
-
- xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
- ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
- }
- else
- /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
- but I don't want to make one now. */
- CHECK_WINDOW (window);
-
- xpos += XINT (x);
- ypos += XINT (y);
-
- XSETFRAME (Vmenu_updating_frame, f);
- }
- else
- Vmenu_updating_frame = Qnil;
-#endif /* HAVE_MENUS */
-
- title = Qnil;
- GCPRO1 (title);
-
- /* Decode the menu items from what was specified. */
-
- keymap = get_keymap (menu, 0, 0);
- if (CONSP (keymap))
- {
- /* We were given a keymap. Extract menu info from the keymap. */
- Lisp_Object prompt;
-
- /* Extract the detailed info to make one pane. */
- keymap_panes (&menu, 1, NILP (position));
-
- /* Search for a string appearing directly as an element of the keymap.
- That string is the title of the menu. */
- prompt = Fkeymap_prompt (keymap);
- if (NILP (title) && !NILP (prompt))
- title = prompt;
-
- /* Make that be the pane title of the first pane. */
- if (!NILP (prompt) && menu_items_n_panes >= 0)
- ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
-
- keymaps = 1;
- }
- else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
- {
- /* We were given a list of keymaps. */
- int nmaps = XFASTINT (Flength (menu));
- Lisp_Object *maps
- = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
- int i;
-
- title = Qnil;
-
- /* The first keymap that has a prompt string
- supplies the menu title. */
- for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
- {
- Lisp_Object prompt;
-
- maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
-
- prompt = Fkeymap_prompt (keymap);
- if (NILP (title) && !NILP (prompt))
- title = prompt;
- }
-
- /* Extract the detailed info to make one pane. */
- keymap_panes (maps, nmaps, NILP (position));
-
- /* Make the title be the pane title of the first pane. */
- if (!NILP (title) && menu_items_n_panes >= 0)
- ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
-
- keymaps = 1;
- }
- else
- {
- /* We were given an old-fashioned menu. */
- title = Fcar (menu);
- CHECK_STRING (title);
-
- list_of_panes (Fcdr (menu));
-
- keymaps = 0;
- }
-
- if (NILP (position))
- {
- discard_menu_items ();
- UNGCPRO;
- return Qnil;
- }
-
-#ifdef HAVE_MENUS
- /* If resources from a previous popup menu still exist, does nothing
- until the `menu_free_timer' has freed them (see w32fns.c). This
- can occur if you press ESC or click outside a menu without selecting
- a menu item.
- */
- if (current_popup_menu)
- {
- discard_menu_items ();
- UNGCPRO;
- return Qnil;
- }
-
- /* Display them in a menu. */
- BLOCK_INPUT;
-
- selection = w32_menu_show (f, xpos, ypos, for_click,
- keymaps, title, &error_name);
- UNBLOCK_INPUT;
-
- discard_menu_items ();
-
-#endif /* HAVE_MENUS */
-
- UNGCPRO;
-
- if (error_name) error (error_name);
- return selection;
-}
-
#ifdef HAVE_MENUS
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
@@ -862,8 +140,7 @@ on the left of the dialog box and all following items on the right.
If HEADER is non-nil, the frame title for the box is "Information",
otherwise it is "Question". */)
- (position, contents, header)
- Lisp_Object position, contents, header;
+ (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
{
FRAME_PTR f = NULL;
Lisp_Object window;
@@ -924,467 +201,164 @@ otherwise it is "Question". */)
CHECK_WINDOW (window);
#ifndef HAVE_DIALOGS
- /* Display a menu with these alternatives
- in the middle of frame F. */
- {
- Lisp_Object x, y, frame, newpos;
- XSETFRAME (frame, f);
- XSETINT (x, x_pixel_width (f) / 2);
- XSETINT (y, x_pixel_height (f) / 2);
- newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
-
- return Fx_popup_menu (newpos,
- Fcons (Fcar (contents), Fcons (contents, Qnil)));
- }
-#else /* HAVE_DIALOGS */
- {
- Lisp_Object title;
- char *error_name;
- Lisp_Object selection;
-
- /* Decode the dialog items from what was specified. */
- title = Fcar (contents);
- CHECK_STRING (title);
- list_of_panes (Fcons (contents, Qnil));
-
- /* Display them in a dialog box. */
- BLOCK_INPUT;
- selection = w32_dialog_show (f, 0, title, header, &error_name);
- UNBLOCK_INPUT;
-
- discard_menu_items ();
-
- if (error_name) error (error_name);
- return selection;
- }
-#endif /* HAVE_DIALOGS */
-}
-
-/* Activate the menu bar of frame F.
- This is called from keyboard.c when it gets the
- MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
-
- To activate the menu bar, we signal to the input thread that it can
- return from the WM_INITMENU message, allowing the normal Windows
- processing of the menus.
-
- But first we recompute the menu bar contents (the whole tree).
-
- This way we can safely execute Lisp code. */
-
-void
-x_activate_menubar (f)
- FRAME_PTR f;
-{
- set_frame_menubar (f, 0, 1);
-
- /* Lock out further menubar changes while active. */
- f->output_data.w32->menubar_active = 1;
-
- /* Signal input thread to return from WM_INITMENU. */
- complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
-}
-
-/* This callback is called from the menu bar pulldown menu
- when the user makes a selection.
- Figure out what the user chose
- and put the appropriate events into the keyboard buffer. */
-
-void
-menubar_selection_callback (FRAME_PTR f, void * client_data)
-{
- Lisp_Object prefix, entry;
- Lisp_Object vector;
- Lisp_Object *subprefix_stack;
- int submenu_depth = 0;
- int i;
-
- if (!f)
- return;
- entry = Qnil;
- subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
- vector = f->menu_bar_vector;
- prefix = Qnil;
- i = 0;
- while (i < f->menu_bar_items_used)
- {
- if (EQ (AREF (vector, i), Qnil))
- {
- subprefix_stack[submenu_depth++] = prefix;
- prefix = entry;
- i++;
- }
- else if (EQ (AREF (vector, i), Qlambda))
- {
- prefix = subprefix_stack[--submenu_depth];
- i++;
- }
- else if (EQ (AREF (vector, i), Qt))
- {
- prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
- i += MENU_ITEMS_PANE_LENGTH;
- }
- else
- {
- entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
- /* The EMACS_INT cast avoids a warning. There's no problem
- as long as pointers have enough bits to hold small integers. */
- if ((int) (EMACS_INT) client_data == i)
- {
- int j;
- struct input_event buf;
- Lisp_Object frame;
- EVENT_INIT (buf);
-
- XSETFRAME (frame, f);
- buf.kind = MENU_BAR_EVENT;
- buf.frame_or_window = frame;
- buf.arg = frame;
- kbd_buffer_store_event (&buf);
-
- for (j = 0; j < submenu_depth; j++)
- if (!NILP (subprefix_stack[j]))
- {
- buf.kind = MENU_BAR_EVENT;
- buf.frame_or_window = frame;
- buf.arg = subprefix_stack[j];
- kbd_buffer_store_event (&buf);
- }
-
- if (!NILP (prefix))
- {
- buf.kind = MENU_BAR_EVENT;
- buf.frame_or_window = frame;
- buf.arg = prefix;
- kbd_buffer_store_event (&buf);
- }
-
- buf.kind = MENU_BAR_EVENT;
- buf.frame_or_window = frame;
- buf.arg = entry;
- /* Free memory used by owner-drawn and help-echo strings. */
- w32_free_menu_strings (FRAME_W32_WINDOW (f));
- kbd_buffer_store_event (&buf);
-
- f->output_data.w32->menubar_active = 0;
- return;
- }
- i += MENU_ITEMS_ITEM_LENGTH;
- }
- }
- /* Free memory used by owner-drawn and help-echo strings. */
- w32_free_menu_strings (FRAME_W32_WINDOW (f));
- f->output_data.w32->menubar_active = 0;
-}
-
-/* Allocate a widget_value, blocking input. */
-
-widget_value *
-xmalloc_widget_value ()
-{
- widget_value *value;
-
- BLOCK_INPUT;
- value = malloc_widget_value ();
- UNBLOCK_INPUT;
-
- return value;
-}
-
-/* This recursively calls free_widget_value on the tree of widgets.
- It must free all data that was malloc'ed for these widget_values.
- In Emacs, many slots are pointers into the data of Lisp_Strings, and
- must be left alone. */
-
-void
-free_menubar_widget_value_tree (wv)
- widget_value *wv;
-{
- if (! wv) return;
-
- wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
-
- if (wv->contents && (wv->contents != (widget_value*)1))
- {
- free_menubar_widget_value_tree (wv->contents);
- wv->contents = (widget_value *) 0xDEADBEEF;
- }
- if (wv->next)
- {
- free_menubar_widget_value_tree (wv->next);
- wv->next = (widget_value *) 0xDEADBEEF;
- }
- BLOCK_INPUT;
- free_widget_value (wv);
- UNBLOCK_INPUT;
-}
-
-/* Set up data i menu_items for a menu bar item
- whose event type is ITEM_KEY (with string ITEM_NAME)
- and whose contents come from the list of keymaps MAPS. */
-
-static int
-parse_single_submenu (item_key, item_name, maps)
- Lisp_Object item_key, item_name, maps;
-{
- Lisp_Object length;
- int len;
- Lisp_Object *mapvec;
- int i;
- int top_level_items = 0;
-
- length = Flength (maps);
- len = XINT (length);
-
- /* Convert the list MAPS into a vector MAPVEC. */
- mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- for (i = 0; i < len; i++)
- {
- mapvec[i] = Fcar (maps);
- maps = Fcdr (maps);
- }
-
- /* Loop over the given keymaps, making a pane for each map.
- But don't make a pane that is empty--ignore that map instead. */
- for (i = 0; i < len; i++)
- {
- if (SYMBOLP (mapvec[i])
- || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
- {
- /* Here we have a command at top level in the menu bar
- as opposed to a submenu. */
- top_level_items = 1;
- push_menu_pane (Qnil, Qnil);
- push_menu_item (item_name, Qt, item_key, mapvec[i],
- Qnil, Qnil, Qnil, Qnil);
- }
- else
- {
- Lisp_Object prompt;
- prompt = Fkeymap_prompt (mapvec[i]);
- single_keymap_panes (mapvec[i],
- !NILP (prompt) ? prompt : item_name,
- item_key, 0, 10);
- }
- }
-
- return top_level_items;
-}
-
-
-/* Create a tree of widget_value objects
- representing the panes and items
- in menu_items starting at index START, up to index END. */
-
-static widget_value *
-digest_single_submenu (start, end, top_level_items)
- int start, end, top_level_items;
-{
- widget_value *wv, *prev_wv, *save_wv, *first_wv;
- int i;
- int submenu_depth = 0;
- widget_value **submenu_stack;
-
- submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
- wv = xmalloc_widget_value ();
- wv->name = "menu";
- wv->value = 0;
- wv->enabled = 1;
- wv->button_type = BUTTON_TYPE_NONE;
- wv->help = Qnil;
- first_wv = wv;
- save_wv = 0;
- prev_wv = 0;
-
- /* Loop over all panes and items made by the preceding call
- to parse_single_submenu and construct a tree of widget_value objects.
- Ignore the panes and items used by previous calls to
- digest_single_submenu, even though those are also in menu_items. */
- i = start;
- while (i < end)
- {
- if (EQ (AREF (menu_items, i), Qnil))
- {
- submenu_stack[submenu_depth++] = save_wv;
- save_wv = prev_wv;
- prev_wv = 0;
- i++;
- }
- else if (EQ (AREF (menu_items, i), Qlambda))
- {
- prev_wv = save_wv;
- save_wv = submenu_stack[--submenu_depth];
- i++;
- }
- else if (EQ (AREF (menu_items, i), Qt)
- && submenu_depth != 0)
- i += MENU_ITEMS_PANE_LENGTH;
- /* Ignore a nil in the item list.
- It's meaningful only for dialog boxes. */
- else if (EQ (AREF (menu_items, i), Qquote))
- i += 1;
- else if (EQ (AREF (menu_items, i), Qt))
- {
- /* Create a new pane. */
- Lisp_Object pane_name, prefix;
- char *pane_string;
-
- pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
- prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
-
- if (STRINGP (pane_name))
- {
- if (unicode_append_menu)
- /* Encode as UTF-8 for now. */
- pane_name = ENCODE_UTF_8 (pane_name);
- else if (STRING_MULTIBYTE (pane_name))
- pane_name = ENCODE_SYSTEM (pane_name);
-
- ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
- }
-
- pane_string = (NILP (pane_name)
- ? "" : (char *) SDATA (pane_name));
- /* If there is just one top-level pane, put all its items directly
- under the top-level menu. */
- if (menu_items_n_panes == 1)
- pane_string = "";
-
- /* If the pane has a meaningful name,
- make the pane a top-level menu item
- with its items as a submenu beneath it. */
- if (strcmp (pane_string, ""))
- {
- wv = xmalloc_widget_value ();
- if (save_wv)
- save_wv->next = wv;
- else
- first_wv->contents = wv;
- wv->lname = pane_name;
- /* Set value to 1 so update_submenu_strings can handle '@' */
- wv->value = (char *) 1;
- wv->enabled = 1;
- wv->button_type = BUTTON_TYPE_NONE;
- wv->help = Qnil;
- }
- save_wv = wv;
- prev_wv = 0;
- i += MENU_ITEMS_PANE_LENGTH;
- }
- else
- {
- /* Create a new item within current pane. */
- Lisp_Object item_name, enable, descrip, def, type, selected;
- Lisp_Object help;
-
- item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
- enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
- descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
- def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
- type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
- selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
- help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
+ {
+ /* Handle simple Yes/No choices as MessageBox popups. */
+ if (is_simple_dialog (contents))
+ return simple_dialog_show (f, contents, header);
+ else
+ {
+ /* Display a menu with these alternatives
+ in the middle of frame F. */
+ Lisp_Object x, y, frame, newpos;
+ XSETFRAME (frame, f);
+ XSETINT (x, x_pixel_width (f) / 2);
+ XSETINT (y, x_pixel_height (f) / 2);
+ newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
+ return Fx_popup_menu (newpos,
+ Fcons (Fcar (contents), Fcons (contents, Qnil)));
+ }
+ }
+#else /* HAVE_DIALOGS */
+ {
+ Lisp_Object title;
+ char *error_name;
+ Lisp_Object selection;
- if (STRINGP (item_name))
- {
- if (unicode_append_menu)
- item_name = ENCODE_UTF_8 (item_name);
- else if (STRING_MULTIBYTE (item_name))
- item_name = ENCODE_SYSTEM (item_name);
+ /* Decode the dialog items from what was specified. */
+ title = Fcar (contents);
+ CHECK_STRING (title);
- ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
- }
+ list_of_panes (Fcons (contents, Qnil));
- if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
- {
- descrip = ENCODE_SYSTEM (descrip);
- ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
- }
+ /* Display them in a dialog box. */
+ BLOCK_INPUT;
+ selection = w32_dialog_show (f, 0, title, header, &error_name);
+ UNBLOCK_INPUT;
- wv = xmalloc_widget_value ();
- if (prev_wv)
- prev_wv->next = wv;
- else
- save_wv->contents = wv;
+ discard_menu_items ();
+ FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
- wv->lname = item_name;
- if (!NILP (descrip))
- wv->lkey = descrip;
- wv->value = 0;
- /* The EMACS_INT cast avoids a warning. There's no problem
- as long as pointers have enough bits to hold small integers. */
- wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
- wv->enabled = !NILP (enable);
+ if (error_name) error (error_name);
+ return selection;
+ }
+#endif /* HAVE_DIALOGS */
+}
- if (NILP (type))
- wv->button_type = BUTTON_TYPE_NONE;
- else if (EQ (type, QCradio))
- wv->button_type = BUTTON_TYPE_RADIO;
- else if (EQ (type, QCtoggle))
- wv->button_type = BUTTON_TYPE_TOGGLE;
- else
- abort ();
+/* Activate the menu bar of frame F.
+ This is called from keyboard.c when it gets the
+ MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
- wv->selected = !NILP (selected);
- if (!STRINGP (help))
- help = Qnil;
+ To activate the menu bar, we signal to the input thread that it can
+ return from the WM_INITMENU message, allowing the normal Windows
+ processing of the menus.
- wv->help = help;
+ But first we recompute the menu bar contents (the whole tree).
- prev_wv = wv;
+ This way we can safely execute Lisp code. */
- i += MENU_ITEMS_ITEM_LENGTH;
- }
- }
+void
+x_activate_menubar (FRAME_PTR f)
+{
+ set_frame_menubar (f, 0, 1);
- /* If we have just one "menu item"
- that was originally a button, return it by itself. */
- if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
- {
- wv = first_wv->contents;
- free_widget_value (first_wv);
- return wv;
- }
+ /* Lock out further menubar changes while active. */
+ f->output_data.w32->menubar_active = 1;
- return first_wv;
+ /* Signal input thread to return from WM_INITMENU. */
+ complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
}
+/* This callback is called from the menu bar pulldown menu
+ when the user makes a selection.
+ Figure out what the user chose
+ and put the appropriate events into the keyboard buffer. */
-/* Walk through the widget_value tree starting at FIRST_WV and update
- the char * pointers from the corresponding lisp values.
- We do this after building the whole tree, since GC may happen while the
- tree is constructed, and small strings are relocated. So we must wait
- until no GC can happen before storing pointers into lisp values. */
-static void
-update_submenu_strings (first_wv)
- widget_value *first_wv;
+void
+menubar_selection_callback (FRAME_PTR f, void * client_data)
{
- widget_value *wv;
+ Lisp_Object prefix, entry;
+ Lisp_Object vector;
+ Lisp_Object *subprefix_stack;
+ int submenu_depth = 0;
+ int i;
- for (wv = first_wv; wv; wv = wv->next)
+ if (!f)
+ return;
+ entry = Qnil;
+ subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
+ vector = f->menu_bar_vector;
+ prefix = Qnil;
+ i = 0;
+ while (i < f->menu_bar_items_used)
{
- if (wv->lname && ! NILP (wv->lname))
- {
- wv->name = SDATA (wv->lname);
+ if (EQ (AREF (vector, i), Qnil))
+ {
+ subprefix_stack[submenu_depth++] = prefix;
+ prefix = entry;
+ i++;
+ }
+ else if (EQ (AREF (vector, i), Qlambda))
+ {
+ prefix = subprefix_stack[--submenu_depth];
+ i++;
+ }
+ else if (EQ (AREF (vector, i), Qt))
+ {
+ prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
+ i += MENU_ITEMS_PANE_LENGTH;
+ }
+ else
+ {
+ entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
+ /* The EMACS_INT cast avoids a warning. There's no problem
+ as long as pointers have enough bits to hold small integers. */
+ if ((int) (EMACS_INT) client_data == i)
+ {
+ int j;
+ struct input_event buf;
+ Lisp_Object frame;
+ EVENT_INIT (buf);
- /* Ignore the @ that means "separate pane".
- This is a kludge, but this isn't worth more time. */
- if (wv->value == (char *)1)
- {
- if (wv->name[0] == '@')
- wv->name++;
- wv->value = 0;
- }
- }
+ XSETFRAME (frame, f);
+ buf.kind = MENU_BAR_EVENT;
+ buf.frame_or_window = frame;
+ buf.arg = frame;
+ kbd_buffer_store_event (&buf);
- if (wv->lkey && ! NILP (wv->lkey))
- wv->key = SDATA (wv->lkey);
+ for (j = 0; j < submenu_depth; j++)
+ if (!NILP (subprefix_stack[j]))
+ {
+ buf.kind = MENU_BAR_EVENT;
+ buf.frame_or_window = frame;
+ buf.arg = subprefix_stack[j];
+ kbd_buffer_store_event (&buf);
+ }
- if (wv->contents)
- update_submenu_strings (wv->contents);
+ if (!NILP (prefix))
+ {
+ buf.kind = MENU_BAR_EVENT;
+ buf.frame_or_window = frame;
+ buf.arg = prefix;
+ kbd_buffer_store_event (&buf);
+ }
+
+ buf.kind = MENU_BAR_EVENT;
+ buf.frame_or_window = frame;
+ buf.arg = entry;
+ /* Free memory used by owner-drawn and help-echo strings. */
+ w32_free_menu_strings (FRAME_W32_WINDOW (f));
+ kbd_buffer_store_event (&buf);
+
+ f->output_data.w32->menubar_active = 0;
+ return;
+ }
+ i += MENU_ITEMS_ITEM_LENGTH;
+ }
}
+ /* Free memory used by owner-drawn and help-echo strings. */
+ w32_free_menu_strings (FRAME_W32_WINDOW (f));
+ f->output_data.w32->menubar_active = 0;
}
@@ -1393,10 +367,7 @@ update_submenu_strings (first_wv)
it is set the first time this is called, from initialize_frame_menubar. */
void
-set_frame_menubar (f, first_time, deep_p)
- FRAME_PTR f;
- int first_time;
- int deep_p;
+set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
{
HMENU menubar_widget = f->output_data.w32->menubar_widget;
Lisp_Object items;
@@ -1449,12 +420,8 @@ set_frame_menubar (f, first_time, deep_p)
set_buffer_internal_1 (XBUFFER (buffer));
- /* Run the Lucid hook. */
+ /* Run the hooks. */
safe_run_hooks (Qactivate_menubar_hook);
- /* If it has changed current-menubar from previous value,
- really recompute the menubar from the value. */
- if (! NILP (Vlucid_menu_bar_dirty_flag))
- call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
@@ -1462,11 +429,13 @@ set_frame_menubar (f, first_time, deep_p)
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
- bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
- previous_menu_items_used * sizeof (Lisp_Object));
+ memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
+ previous_menu_items_used * sizeof (Lisp_Object));
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
+ save_menu_items ();
+
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
@@ -1526,7 +495,6 @@ set_frame_menubar (f, first_time, deep_p)
}
set_buffer_internal_1 (prev);
- unbind_to (specpdl_count, Qnil);
/* If there has been no change in the Lisp-level contents
of the menu bar, skip redisplaying it. Just exit. */
@@ -1538,11 +506,17 @@ set_frame_menubar (f, first_time, deep_p)
if (i == menu_items_used && i == previous_menu_items_used && i != 0)
{
free_menubar_widget_value_tree (first_wv);
- menu_items = Qnil;
-
+ discard_menu_items ();
+ unbind_to (specpdl_count, Qnil);
return;
}
+ f->menu_bar_vector = menu_items;
+ f->menu_bar_items_used = menu_items_used;
+
+ /* This undoes save_menu_items. */
+ unbind_to (specpdl_count, Qnil);
+
/* Now GC cannot happen during the lifetime of the widget_value,
so it's safe to store data from a Lisp_String, as long as
local copies are made when the actual menu is created.
@@ -1559,10 +533,6 @@ set_frame_menubar (f, first_time, deep_p)
update_submenu_strings (wv->contents);
wv = wv->next;
}
-
- f->menu_bar_vector = menu_items;
- f->menu_bar_items_used = menu_items_used;
- menu_items = Qnil;
}
else
{
@@ -1652,8 +622,7 @@ set_frame_menubar (f, first_time, deep_p)
is visible. */
void
-initialize_frame_menubar (f)
- FRAME_PTR f;
+initialize_frame_menubar (FRAME_PTR f)
{
/* This function is called before the first chance to redisplay
the frame. It has to be, so the frame will have the right size. */
@@ -1665,8 +634,7 @@ initialize_frame_menubar (f)
This is used when deleting a frame, and when turning off the menu bar. */
void
-free_frame_menubar (f)
- FRAME_PTR f;
+free_frame_menubar (FRAME_PTR f)
{
BLOCK_INPUT;
@@ -1696,15 +664,9 @@ free_frame_menubar (f)
ERROR is a place to store an error message string in case of failure.
(We return nil on failure, but the value doesn't actually matter.) */
-static Lisp_Object
-w32_menu_show (f, x, y, for_click, keymaps, title, error)
- FRAME_PTR f;
- int x;
- int y;
- int for_click;
- int keymaps;
- Lisp_Object title;
- char **error;
+Lisp_Object
+w32_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
+ Lisp_Object title, const char **error)
{
int i;
int menu_item_selection;
@@ -1720,6 +682,9 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
*error = NULL;
+ if (menu_items_n_panes == 0)
+ return Qnil;
+
if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
{
*error = "Empty menu";
@@ -1869,6 +834,7 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
abort ();
wv->selected = !NILP (selected);
+
if (!STRINGP (help))
help = Qnil;
@@ -1906,6 +872,9 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
first_wv->contents = wv_title;
}
+ /* No selection has been chosen yet. */
+ menu_item_selection = 0;
+
/* Actually create the menu. */
current_popup_menu = menu = CreatePopupMenu ();
fill_in_menu (menu, first_wv->contents);
@@ -1915,9 +884,6 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
pos.y = y;
ClientToScreen (FRAME_W32_WINDOW (f), &pos);
- /* No selection has been chosen yet. */
- menu_item_selection = 0;
-
/* Display the menu. */
menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
WM_EMACS_TRACKPOPUPMENU,
@@ -1926,6 +892,7 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
/* Clean up extraneous mouse events which might have been generated
during the call. */
discard_mouse_events ();
+ FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
/* Free the widget_value objects we used to specify the contents. */
free_menubar_widget_value_tree (first_wv);
@@ -1997,16 +964,37 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error)
#ifdef HAVE_DIALOGS
+/* TODO: On Windows, there are two ways of defining a dialog.
+
+ 1. Create a predefined dialog resource and include it in nt/emacs.rc.
+ Using this method, we could then set the titles and make unneeded
+ buttons invisible before displaying the dialog. Everything would
+ be a fixed size though, so there is a risk that text does not
+ fit on a button.
+ 2. Create the dialog template in memory on the fly. This allows us
+ to size the dialog and buttons dynamically, probably giving more
+ natural looking results for dialogs with few buttons, and eliminating
+ the problem of text overflowing the buttons. But the API for this is
+ quite complex - structures have to be allocated in particular ways,
+ text content is tacked onto the end of structures in variable length
+ arrays with further structures tacked on after these, there are
+ certain alignment requirements for all this, and we have to
+ measure all the text and convert to "dialog coordinates" to figure
+ out how big to make everything.
+
+ For now, we'll just stick with menus for dialogs that are more
+ complicated than simple yes/no type questions for which we can use
+ the MessageBox function.
+*/
+
static char * button_names [] = {
"button1", "button2", "button3", "button4", "button5",
"button6", "button7", "button8", "button9", "button10" };
static Lisp_Object
-w32_dialog_show (f, keymaps, title, header, error)
- FRAME_PTR f;
- int keymaps;
- Lisp_Object title, header;
- char **error;
+w32_dialog_show (FRAME_PTR f, int keymaps,
+ Lisp_Object title, Lisp_Object header,
+ char **error)
{
int i, nb_buttons=0;
char dialog_name[6];
@@ -2109,7 +1097,7 @@ w32_dialog_show (f, keymaps, title, header, error)
/* Frame title: 'Q' = Question, 'I' = Information.
Can also have 'E' = Error if, one day, we want
a popup for errors. */
- if (NILP(header))
+ if (NILP (header))
dialog_name[0] = 'Q';
else
dialog_name[0] = 'I';
@@ -2188,15 +1176,160 @@ w32_dialog_show (f, keymaps, title, header, error)
return Qnil;
}
-#endif /* HAVE_DIALOGS */
+#else /* !HAVE_DIALOGS */
+
+/* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
+ simple dialogs. We could handle a few more, but I'm not aware of
+ anywhere in Emacs that uses the other specific dialog choices that
+ MessageBox provides. */
+
+static int
+is_simple_dialog (Lisp_Object contents)
+{
+ Lisp_Object options = XCDR (contents);
+ Lisp_Object name, yes, no, other;
+
+ yes = build_string ("Yes");
+ no = build_string ("No");
+
+ if (!CONSP (options))
+ return 0;
+
+ name = XCAR (XCAR (options));
+ if (!CONSP (options))
+ return 0;
+
+ if (!NILP (Fstring_equal (name, yes)))
+ other = no;
+ else if (!NILP (Fstring_equal (name, no)))
+ other = yes;
+ else
+ return 0;
+
+ options = XCDR (options);
+ if (!CONSP (options))
+ return 0;
+
+ name = XCAR (XCAR (options));
+ if (NILP (Fstring_equal (name, other)))
+ return 0;
+
+ /* Check there are no more options. */
+ options = XCDR (options);
+ return !(CONSP (options));
+}
+
+static Lisp_Object
+simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header)
+{
+ int answer;
+ UINT type;
+ Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
+
+ type = MB_YESNO;
+
+ /* Since we only handle Yes/No dialogs, and we already checked
+ is_simple_dialog, we don't need to worry about checking contents
+ to see what type of dialog to use. */
+
+ /* Use unicode if possible, so any language can be displayed. */
+ if (unicode_message_box)
+ {
+ WCHAR *text, *title;
+
+ if (STRINGP (temp))
+ {
+ char *utf8_text = SDATA (ENCODE_UTF_8 (temp));
+ /* Be pessimistic about the number of characters needed.
+ Remember characters outside the BMP will take more than
+ one utf16 word, so we cannot simply use the character
+ length of temp. */
+ int utf8_len = strlen (utf8_text);
+ text = alloca ((utf8_len + 1) * sizeof (WCHAR));
+ utf8to16 (utf8_text, utf8_len, text);
+ }
+ else
+ {
+ text = L"";
+ }
+
+ if (NILP (header))
+ {
+ title = L"Question";
+ type |= MB_ICONQUESTION;
+ }
+ else
+ {
+ title = L"Information";
+ type |= MB_ICONINFORMATION;
+ }
+
+ answer = unicode_message_box (FRAME_W32_WINDOW (f), text, title, type);
+ }
+ else
+ {
+ char *text, *title;
+
+ /* Fall back on ANSI message box, but at least use system
+ encoding so questions representable by the system codepage
+ are encoded properly. */
+ if (STRINGP (temp))
+ text = SDATA (ENCODE_SYSTEM (temp));
+ else
+ text = "";
+
+ if (NILP (header))
+ {
+ title = "Question";
+ type |= MB_ICONQUESTION;
+ }
+ else
+ {
+ title = "Information";
+ type |= MB_ICONINFORMATION;
+ }
+
+ answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
+ }
+
+ if (answer == IDYES)
+ lispy_answer = build_string ("Yes");
+ else if (answer == IDNO)
+ lispy_answer = build_string ("No");
+ else
+ Fsignal (Qquit, Qnil);
+
+ for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
+ {
+ Lisp_Object item, name, value;
+ item = XCAR (temp);
+ if (CONSP (item))
+ {
+ name = XCAR (item);
+ value = XCDR (item);
+ }
+ else
+ {
+ name = item;
+ value = Qnil;
+ }
+
+ if (!NILP (Fstring_equal (name, lispy_answer)))
+ {
+ return value;
+ }
+ }
+ Fsignal (Qquit, Qnil);
+ return Qnil;
+}
+#endif /* !HAVE_DIALOGS */
/* Is this item a separator? */
static int
-name_is_separator (name)
- char *name;
+name_is_separator (const char *name)
{
- char *start = name;
+ const char *start = name;
/* Check if name string consists of only dashes ('-'). */
while (*name == '-') name++;
@@ -2206,14 +1339,6 @@ name_is_separator (name)
return (*name == '\0' || start + 2 == name);
}
-
-/* Indicate boundary between left and right. */
-static int
-add_left_right_boundary (HMENU menu)
-{
- return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
-}
-
/* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
static void
utf8to16 (unsigned char * src, int len, WCHAR * dest)
@@ -2282,7 +1407,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
strcat (out_string, wv->key);
}
else
- out_string = wv->name;
+ out_string = (char *)wv->name;
/* Quote any special characters within the menu item's text and
key binding. */
@@ -2411,7 +1536,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
if (set_menu_item_info)
{
MENUITEMINFO info;
- bzero (&info, sizeof (info));
+ memset (&info, 0, sizeof (info));
info.cbSize = sizeof (info);
info.fMask = MIIM_DATA;
@@ -2494,7 +1619,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
{
MENUITEMINFO info;
- bzero (&info, sizeof (info));
+ memset (&info, 0, sizeof (info));
info.cbSize = sizeof (info);
info.fMask = MIIM_DATA;
get_menu_item_info (menu, item, FALSE, &info);
@@ -2525,14 +1650,13 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
/* Free memory used by owner-drawn strings. */
static void
-w32_free_submenu_strings (menu)
- HMENU menu;
+w32_free_submenu_strings (HMENU menu)
{
int i, num = GetMenuItemCount (menu);
for (i = 0; i < num; i++)
{
MENUITEMINFO info;
- bzero (&info, sizeof (info));
+ memset (&info, 0, sizeof (info));
info.cbSize = sizeof (info);
info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
@@ -2554,8 +1678,7 @@ w32_free_submenu_strings (menu)
}
void
-w32_free_menu_strings (hwnd)
- HWND hwnd;
+w32_free_menu_strings (HWND hwnd)
{
HMENU menu = current_popup_menu;
@@ -2579,7 +1702,7 @@ w32_free_menu_strings (hwnd)
DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
doc: /* Return t if a menu or popup dialog is active on selected frame. */)
- ()
+ (void)
{
#ifdef HAVE_MENUS
FRAME_PTR f;
@@ -2590,17 +1713,15 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_
#endif /* HAVE_MENUS */
}
-void syms_of_w32menu ()
+void
+syms_of_w32menu (void)
{
globals_of_w32menu ();
- staticpro (&menu_items);
- menu_items = Qnil;
current_popup_menu = NULL;
DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
- defsubr (&Sx_popup_menu);
defsubr (&Smenu_or_popup_active_p);
#ifdef HAVE_MENUS
defsubr (&Sx_popup_dialog);
@@ -2615,13 +1736,15 @@ void syms_of_w32menu ()
variable initialized is 0 and directly from main when initialized
is non zero.
*/
-void globals_of_w32menu ()
+void
+globals_of_w32menu (void)
{
/* See if Get/SetMenuItemInfo functions are available. */
HMODULE user32 = GetModuleHandle ("user32.dll");
get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
+ unicode_message_box = (MessageBoxW_Proc) GetProcAddress (user32, "MessageBoxW");
}
/* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0