mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-29 00:31:01 -08:00
2146 lines
53 KiB
C
2146 lines
53 KiB
C
/* Menu support for GNU Emacs on the Microsoft W32 API.
|
||
Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
|
||
|
||
This file is part of GNU Emacs.
|
||
|
||
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 2, 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
|
||
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., 59 Temple Place - Suite 330,
|
||
Boston, MA 02111-1307, USA. */
|
||
|
||
/* Written by Kevin Gallo. */
|
||
|
||
#include <signal.h>
|
||
#include <config.h>
|
||
|
||
#include <stdio.h>
|
||
#include "lisp.h"
|
||
#include "termhooks.h"
|
||
#include "frame.h"
|
||
#include "window.h"
|
||
#include "keyboard.h"
|
||
#include "blockinput.h"
|
||
#include "buffer.h"
|
||
|
||
/* This may include sys/types.h, and that somehow loses
|
||
if this is not done before the other system files. */
|
||
#include "w32term.h"
|
||
|
||
/* Load sys/types.h if not already loaded.
|
||
In some systems loading it twice is suicidal. */
|
||
#ifndef makedev
|
||
#include <sys/types.h>
|
||
#endif
|
||
|
||
#include "dispextern.h"
|
||
|
||
#define min(x, y) (((x) < (y)) ? (x) : (y))
|
||
#define max(x, y) (((x) > (y)) ? (x) : (y))
|
||
|
||
typedef struct menu_map
|
||
{
|
||
Lisp_Object menu_items;
|
||
int menu_items_allocated;
|
||
int menu_items_used;
|
||
} menu_map;
|
||
|
||
Lisp_Object Qdebug_on_next_call;
|
||
|
||
extern Lisp_Object Qmenu_enable;
|
||
extern Lisp_Object Qmenu_bar;
|
||
|
||
extern Lisp_Object Voverriding_local_map;
|
||
extern Lisp_Object Voverriding_local_map_menu_flag;
|
||
|
||
extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
|
||
|
||
extern Lisp_Object Qmenu_bar_update_hook;
|
||
|
||
void set_frame_menubar ();
|
||
|
||
static Lisp_Object w32_dialog_show ();
|
||
static Lisp_Object w32menu_show ();
|
||
|
||
static HMENU keymap_panes ();
|
||
static HMENU single_keymap_panes ();
|
||
static HMENU list_of_panes ();
|
||
static HMENU list_of_items ();
|
||
|
||
static HMENU create_menu_items ();
|
||
|
||
/* Initialize the menu_items structure if we haven't already done so.
|
||
Also mark it as currently empty. */
|
||
|
||
#if 0
|
||
static void
|
||
init_menu_items (lpmm)
|
||
menu_map * lpmm;
|
||
{
|
||
if (NILP (lpmm->menu_items))
|
||
{
|
||
lpmm->menu_items_allocated = 60;
|
||
lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
|
||
Qnil);
|
||
}
|
||
|
||
lpmm->menu_items_used = 0;
|
||
}
|
||
|
||
/* Make the menu_items vector twice as large. */
|
||
|
||
static void
|
||
grow_menu_items (lpmm)
|
||
menu_map * lpmm;
|
||
{
|
||
Lisp_Object new;
|
||
int old_size = lpmm->menu_items_allocated;
|
||
|
||
lpmm->menu_items_allocated *= 2;
|
||
new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
|
||
bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
|
||
old_size * sizeof (Lisp_Object));
|
||
|
||
lpmm->menu_items = new;
|
||
}
|
||
#endif
|
||
|
||
/* Call when finished using the data for the current menu
|
||
in menu_items. */
|
||
|
||
static void
|
||
discard_menu_items (lpmm)
|
||
menu_map * lpmm;
|
||
{
|
||
#if 0
|
||
lpmm->menu_items = Qnil;
|
||
#endif
|
||
lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
|
||
}
|
||
|
||
/* Is this item a separator? */
|
||
static int
|
||
name_is_separator (name)
|
||
Lisp_Object name;
|
||
{
|
||
int isseparator = (((char *)XSTRING (name)->data)[0] == 0);
|
||
|
||
if (!isseparator)
|
||
{
|
||
/* Check if name string consists of only dashes ('-') */
|
||
char *string = (char *)XSTRING (name)->data;
|
||
while (*string == '-') string++;
|
||
isseparator = (*string == 0);
|
||
}
|
||
|
||
return isseparator;
|
||
}
|
||
|
||
|
||
/* Indicate boundary between left and right. */
|
||
|
||
static void
|
||
add_left_right_boundary (hmenu)
|
||
HMENU hmenu;
|
||
{
|
||
AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
|
||
}
|
||
|
||
/* 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. EQUIV is the textual description
|
||
of the keyboard equivalent for this item (or nil if none). */
|
||
|
||
static void
|
||
add_menu_item (lpmm, hmenu, name, enable, key, equiv)
|
||
menu_map * lpmm;
|
||
HMENU hmenu;
|
||
Lisp_Object name;
|
||
UINT enable;
|
||
Lisp_Object key;
|
||
Lisp_Object equiv;
|
||
{
|
||
UINT fuFlags;
|
||
Lisp_Object out_string;
|
||
|
||
if (NILP (name) || name_is_separator (name))
|
||
fuFlags = MF_SEPARATOR;
|
||
else
|
||
{
|
||
if (enable)
|
||
fuFlags = MF_STRING;
|
||
else
|
||
fuFlags = MF_STRING | MF_GRAYED;
|
||
|
||
if (!NILP (equiv))
|
||
{
|
||
out_string = concat2 (name, make_string ("\t", 1));
|
||
out_string = concat2 (out_string, equiv);
|
||
}
|
||
else
|
||
out_string = name;
|
||
}
|
||
|
||
AppendMenu (hmenu,
|
||
fuFlags,
|
||
lpmm->menu_items_used + 1,
|
||
(fuFlags == MF_SEPARATOR)?NULL:
|
||
(char *) XSTRING (out_string)->data);
|
||
|
||
lpmm->menu_items_used++;
|
||
#if 0
|
||
if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
|
||
grow_menu_items (lpmm);
|
||
|
||
XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
|
||
Lisp_Cons,
|
||
key);
|
||
#endif
|
||
}
|
||
|
||
/* Figure out the current keyboard equivalent of a menu item ITEM1.
|
||
The item string for menu display should be ITEM_STRING.
|
||
Store the equivalent keyboard key sequence's
|
||
textual description into *DESCRIP_PTR.
|
||
Also cache them in the item itself.
|
||
Return the real definition to execute. */
|
||
|
||
static Lisp_Object
|
||
menu_item_equiv_key (item_string, item1, descrip_ptr)
|
||
Lisp_Object item_string;
|
||
Lisp_Object item1;
|
||
Lisp_Object *descrip_ptr;
|
||
{
|
||
/* This is the real definition--the function to run. */
|
||
Lisp_Object def;
|
||
/* This is the sublist that records cached equiv key data
|
||
so we can save time. */
|
||
Lisp_Object cachelist;
|
||
/* These are the saved equivalent keyboard key sequence
|
||
and its key-description. */
|
||
Lisp_Object savedkey, descrip;
|
||
Lisp_Object def1;
|
||
int changed = 0;
|
||
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
||
|
||
/* If a help string follows the item string, skip it. */
|
||
if (CONSP (XCONS (item1)->cdr)
|
||
&& STRINGP (XCONS (XCONS (item1)->cdr)->car))
|
||
item1 = XCONS (item1)->cdr;
|
||
|
||
def = Fcdr (item1);
|
||
|
||
/* Get out the saved equivalent-keyboard-key info. */
|
||
cachelist = savedkey = descrip = Qnil;
|
||
if (CONSP (def) && CONSP (XCONS (def)->car)
|
||
&& (NILP (XCONS (XCONS (def)->car)->car)
|
||
|| VECTORP (XCONS (XCONS (def)->car)->car)))
|
||
{
|
||
cachelist = XCONS (def)->car;
|
||
def = XCONS (def)->cdr;
|
||
savedkey = XCONS (cachelist)->car;
|
||
descrip = XCONS (cachelist)->cdr;
|
||
}
|
||
|
||
GCPRO4 (def, def1, savedkey, descrip);
|
||
|
||
/* Is it still valid? */
|
||
def1 = Qnil;
|
||
if (!NILP (savedkey))
|
||
def1 = Fkey_binding (savedkey, Qnil);
|
||
/* If not, update it. */
|
||
if (! EQ (def1, def)
|
||
/* If the command is an alias for another
|
||
(such as easymenu.el and lmenu.el set it up),
|
||
check if the original command matches the cached command. */
|
||
&& !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
|
||
&& EQ (def1, XSYMBOL (def)->function))
|
||
/* If something had no key binding before, don't recheck it--
|
||
doing that takes too much time and makes menus too slow. */
|
||
&& !(!NILP (cachelist) && NILP (savedkey)))
|
||
{
|
||
changed = 1;
|
||
descrip = Qnil;
|
||
savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
|
||
/* If the command is an alias for another
|
||
(such as easymenu.el and lmenu.el set it up),
|
||
see if the original command name has equivalent keys. */
|
||
if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
|
||
savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
|
||
Qnil, Qt, Qnil);
|
||
|
||
if (VECTORP (savedkey)
|
||
&& EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
|
||
savedkey = Qnil;
|
||
if (!NILP (savedkey))
|
||
{
|
||
descrip = Fkey_description (savedkey);
|
||
descrip = concat2 (make_string (" (", 3), descrip);
|
||
descrip = concat2 (descrip, make_string (")", 1));
|
||
}
|
||
}
|
||
|
||
/* Cache the data we just got in a sublist of the menu binding. */
|
||
if (NILP (cachelist))
|
||
XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
|
||
else if (changed)
|
||
{
|
||
XCONS (cachelist)->car = savedkey;
|
||
XCONS (cachelist)->cdr = descrip;
|
||
}
|
||
|
||
UNGCPRO;
|
||
*descrip_ptr = descrip;
|
||
return def;
|
||
}
|
||
|
||
/* This is used as the handler when calling internal_condition_case_1. */
|
||
|
||
static Lisp_Object
|
||
menu_item_enabled_p_1 (arg)
|
||
Lisp_Object arg;
|
||
{
|
||
return Qnil;
|
||
}
|
||
|
||
/* Return non-nil if the command DEF is enabled when used as a menu item.
|
||
This is based on looking for a menu-enable property.
|
||
If NOTREAL is set, don't bother really computing this. */
|
||
|
||
static Lisp_Object
|
||
menu_item_enabled_p (def, notreal)
|
||
Lisp_Object def;
|
||
{
|
||
Lisp_Object enabled, tem;
|
||
|
||
enabled = Qt;
|
||
if (notreal)
|
||
return enabled;
|
||
if (XTYPE (def) == Lisp_Symbol)
|
||
{
|
||
/* No property, or nil, means enable.
|
||
Otherwise, enable if value is not nil. */
|
||
tem = Fget (def, Qmenu_enable);
|
||
if (!NILP (tem))
|
||
/* (condition-case nil (eval tem)
|
||
(error nil)) */
|
||
enabled = internal_condition_case_1 (Feval, tem, Qerror,
|
||
menu_item_enabled_p_1);
|
||
}
|
||
return enabled;
|
||
}
|
||
|
||
/* 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 HMENU
|
||
keymap_panes (lpmm, keymaps, nmaps, notreal)
|
||
menu_map * lpmm;
|
||
Lisp_Object *keymaps;
|
||
int nmaps;
|
||
int notreal;
|
||
{
|
||
int mapno;
|
||
|
||
#if 0
|
||
init_menu_items (lpmm);
|
||
#endif
|
||
|
||
if (nmaps > 1)
|
||
{
|
||
HMENU hmenu;
|
||
|
||
if (!notreal)
|
||
{
|
||
hmenu = CreatePopupMenu ();
|
||
|
||
if (!hmenu) return (NULL);
|
||
}
|
||
else
|
||
{
|
||
hmenu = NULL;
|
||
}
|
||
|
||
/* 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++)
|
||
{
|
||
HMENU new_hmenu;
|
||
|
||
new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
|
||
Qnil, Qnil, notreal);
|
||
|
||
if (!notreal && new_hmenu)
|
||
{
|
||
AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
|
||
}
|
||
}
|
||
|
||
return (hmenu);
|
||
}
|
||
else
|
||
{
|
||
return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
|
||
}
|
||
}
|
||
|
||
/* 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,
|
||
don't bother really computing whether an item is enabled. */
|
||
|
||
HMENU
|
||
single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
|
||
menu_map * lpmm;
|
||
Lisp_Object keymap;
|
||
Lisp_Object pane_name;
|
||
Lisp_Object prefix;
|
||
int notreal;
|
||
{
|
||
Lisp_Object pending_maps;
|
||
Lisp_Object tail, item, item1, item_string, table;
|
||
HMENU hmenu;
|
||
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
||
|
||
if (!notreal)
|
||
{
|
||
hmenu = CreatePopupMenu ();
|
||
if (hmenu == NULL) return NULL;
|
||
}
|
||
else
|
||
{
|
||
hmenu = NULL;
|
||
}
|
||
|
||
pending_maps = Qnil;
|
||
|
||
for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
|
||
{
|
||
/* Look at each key binding, and if it has a menu string,
|
||
make a menu item from it. */
|
||
|
||
item = XCONS (tail)->car;
|
||
|
||
if (CONSP (item))
|
||
{
|
||
item1 = XCONS (item)->cdr;
|
||
|
||
if (XTYPE (item1) == Lisp_Cons)
|
||
{
|
||
item_string = XCONS (item1)->car;
|
||
if (XTYPE (item_string) == Lisp_String)
|
||
{
|
||
/* This is the real definition--the function to run. */
|
||
|
||
Lisp_Object def;
|
||
|
||
/* These are the saved equivalent keyboard key sequence
|
||
and its key-description. */
|
||
|
||
Lisp_Object descrip;
|
||
Lisp_Object tem, enabled;
|
||
|
||
/* GCPRO because ...enabled_p will call eval
|
||
and ..._equiv_key may autoload something.
|
||
Protecting KEYMAP preserves everything we use;
|
||
aside from that, must protect whatever might be
|
||
a string. Since there's no GCPRO5, we refetch
|
||
item_string instead of protecting it. */
|
||
|
||
descrip = def = Qnil;
|
||
GCPRO4 (keymap, pending_maps, def, prefix);
|
||
|
||
def = menu_item_equiv_key (item_string, item1, &descrip);
|
||
{
|
||
struct gcpro gcpro1;
|
||
GCPRO1 (descrip);
|
||
enabled = menu_item_enabled_p (def, notreal);
|
||
UNGCPRO;
|
||
}
|
||
|
||
UNGCPRO;
|
||
|
||
item_string = XCONS (item1)->car;
|
||
|
||
tem = Fkeymapp (def);
|
||
if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
|
||
{
|
||
pending_maps = Fcons (Fcons (def,
|
||
Fcons (item_string,
|
||
XCONS (item)->car)),
|
||
pending_maps);
|
||
}
|
||
else
|
||
{
|
||
Lisp_Object submap;
|
||
|
||
GCPRO5 (keymap, pending_maps, item, item_string, descrip);
|
||
|
||
submap = get_keymap_1 (def, 0, 1);
|
||
|
||
UNGCPRO;
|
||
|
||
if (NILP (submap))
|
||
{
|
||
if (!notreal)
|
||
{
|
||
add_menu_item (lpmm,
|
||
hmenu,
|
||
item_string,
|
||
!NILP (enabled),
|
||
Fcons (XCONS (item)->car, prefix),
|
||
descrip);
|
||
}
|
||
}
|
||
else
|
||
/* Display a submenu. */
|
||
{
|
||
HMENU new_hmenu = single_keymap_panes (lpmm,
|
||
submap,
|
||
item_string,
|
||
XCONS (item)->car,
|
||
notreal);
|
||
|
||
if (!notreal)
|
||
{
|
||
AppendMenu (hmenu, MF_POPUP,
|
||
(UINT)new_hmenu,
|
||
(char *) XSTRING (item_string)->data);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
else if (VECTORP (item))
|
||
{
|
||
/* Loop over the char values represented in the vector. */
|
||
int len = XVECTOR (item)->size;
|
||
int c;
|
||
for (c = 0; c < len; c++)
|
||
{
|
||
Lisp_Object character;
|
||
XSETFASTINT (character, c);
|
||
item1 = XVECTOR (item)->contents[c];
|
||
if (CONSP (item1))
|
||
{
|
||
item_string = XCONS (item1)->car;
|
||
if (STRINGP (item_string))
|
||
{
|
||
Lisp_Object def;
|
||
|
||
/* These are the saved equivalent keyboard key sequence
|
||
and its key-description. */
|
||
Lisp_Object descrip;
|
||
Lisp_Object tem, enabled;
|
||
|
||
/* GCPRO because ...enabled_p will call eval
|
||
and ..._equiv_key may autoload something.
|
||
Protecting KEYMAP preserves everything we use;
|
||
aside from that, must protect whatever might be
|
||
a string. Since there's no GCPRO5, we refetch
|
||
item_string instead of protecting it. */
|
||
GCPRO3 (keymap, pending_maps, def);
|
||
descrip = def = Qnil;
|
||
|
||
def = menu_item_equiv_key (item_string, item1, &descrip);
|
||
{
|
||
struct gcpro gcpro1;
|
||
GCPRO1 (descrip);
|
||
enabled = menu_item_enabled_p (def, notreal);
|
||
UNGCPRO;
|
||
}
|
||
|
||
UNGCPRO;
|
||
|
||
item_string = XCONS (item1)->car;
|
||
|
||
tem = Fkeymapp (def);
|
||
if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
|
||
pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
|
||
pending_maps);
|
||
else
|
||
{
|
||
Lisp_Object submap;
|
||
|
||
GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
|
||
|
||
submap = get_keymap_1 (def, 0, 1);
|
||
|
||
UNGCPRO;
|
||
|
||
if (NILP (submap))
|
||
{
|
||
if (!notreal)
|
||
{
|
||
add_menu_item (lpmm,
|
||
hmenu,
|
||
item_string,
|
||
!NILP (enabled),
|
||
character,
|
||
descrip);
|
||
}
|
||
}
|
||
else
|
||
/* Display a submenu. */
|
||
{
|
||
HMENU new_hmenu = single_keymap_panes (lpmm,
|
||
submap,
|
||
Qnil,
|
||
character,
|
||
notreal);
|
||
|
||
if (!notreal)
|
||
{
|
||
AppendMenu (hmenu,MF_POPUP,
|
||
(UINT)new_hmenu,
|
||
(char *)XSTRING (item_string)->data);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
/* 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 = XCONS (elt)->cdr;
|
||
string = XCONS (eltcdr)->car;
|
||
/* We no longer discard the @ from the beginning of the string here.
|
||
Instead, we do this in w32menu_show. */
|
||
{
|
||
HMENU new_hmenu = single_keymap_panes (lpmm,
|
||
Fcar (elt),
|
||
string,
|
||
XCONS (eltcdr)->cdr, notreal);
|
||
|
||
if (!notreal)
|
||
{
|
||
AppendMenu (hmenu, MF_POPUP,
|
||
(UINT)new_hmenu,
|
||
(char *) XSTRING (string)->data);
|
||
}
|
||
}
|
||
|
||
pending_maps = Fcdr (pending_maps);
|
||
}
|
||
|
||
return (hmenu);
|
||
}
|
||
|
||
/* 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 HMENU
|
||
list_of_panes (lpmm, menu)
|
||
menu_map * lpmm;
|
||
Lisp_Object menu;
|
||
{
|
||
Lisp_Object tail;
|
||
HMENU hmenu;
|
||
|
||
if (XFASTINT (Flength (menu)) > 1)
|
||
{
|
||
hmenu = CreatePopupMenu ();
|
||
if (hmenu == NULL) return NULL;
|
||
|
||
/* init_menu_items (lpmm); */
|
||
|
||
for (tail = menu; !NILP (tail); tail = Fcdr (tail))
|
||
{
|
||
Lisp_Object elt, pane_name, pane_data;
|
||
HMENU new_hmenu;
|
||
|
||
elt = Fcar (tail);
|
||
pane_name = Fcar (elt);
|
||
CHECK_STRING (pane_name, 0);
|
||
pane_data = Fcdr (elt);
|
||
CHECK_CONS (pane_data, 0);
|
||
|
||
if (XSTRING (pane_name)->data[0] == 0)
|
||
{
|
||
list_of_items (hmenu, lpmm, pane_data);
|
||
}
|
||
else
|
||
{
|
||
new_hmenu = list_of_items (NULL, lpmm, pane_data);
|
||
if (new_hmenu == NULL) goto error;
|
||
|
||
AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
|
||
(char *) XSTRING (pane_name)->data);
|
||
}
|
||
}
|
||
}
|
||
else
|
||
{
|
||
Lisp_Object elt, pane_name, pane_data;
|
||
|
||
elt = Fcar (menu);
|
||
pane_name = Fcar (elt);
|
||
CHECK_STRING (pane_name, 0);
|
||
pane_data = Fcdr (elt);
|
||
CHECK_CONS (pane_data, 0);
|
||
hmenu = list_of_items (NULL, lpmm, pane_data);
|
||
}
|
||
return (hmenu);
|
||
|
||
error:
|
||
DestroyMenu (hmenu);
|
||
|
||
return (NULL);
|
||
}
|
||
|
||
/* Push the items in a single pane defined by the alist PANE. */
|
||
|
||
static HMENU
|
||
list_of_items (hmenu, lpmm, pane)
|
||
HMENU hmenu;
|
||
menu_map * lpmm;
|
||
Lisp_Object pane;
|
||
{
|
||
Lisp_Object tail, item, item1;
|
||
|
||
if (hmenu == NULL)
|
||
{
|
||
hmenu = CreatePopupMenu ();
|
||
if (hmenu == NULL) return NULL;
|
||
}
|
||
|
||
for (tail = pane; !NILP (tail); tail = Fcdr (tail))
|
||
{
|
||
item = Fcar (tail);
|
||
if (STRINGP (item))
|
||
add_menu_item (lpmm, hmenu, item, 0, Qnil, Qnil);
|
||
else if (NILP (item))
|
||
add_left_right_boundary ();
|
||
else
|
||
{
|
||
CHECK_CONS (item, 0);
|
||
item1 = Fcar (item);
|
||
CHECK_STRING (item1, 1);
|
||
add_menu_item (lpmm, hmenu, item1, 1, Fcdr (item), Qnil);
|
||
}
|
||
}
|
||
|
||
return (hmenu);
|
||
}
|
||
|
||
|
||
HMENU
|
||
create_menu_items (lpmm, menu, notreal)
|
||
menu_map * lpmm;
|
||
Lisp_Object menu;
|
||
int notreal;
|
||
{
|
||
Lisp_Object title;
|
||
Lisp_Object keymap, tem;
|
||
HMENU hmenu;
|
||
|
||
title = Qnil;
|
||
|
||
/* Decode the menu items from what was specified. */
|
||
|
||
keymap = Fkeymapp (menu);
|
||
tem = Qnil;
|
||
if (XTYPE (menu) == Lisp_Cons)
|
||
tem = Fkeymapp (Fcar (menu));
|
||
|
||
if (!NILP (keymap))
|
||
{
|
||
/* We were given a keymap. Extract menu info from the keymap. */
|
||
Lisp_Object prompt;
|
||
keymap = get_keymap (menu);
|
||
|
||
/* Extract the detailed info to make one pane. */
|
||
hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
|
||
|
||
#if 0
|
||
/* Search for a string appearing directly as an element of the keymap.
|
||
That string is the title of the menu. */
|
||
prompt = map_prompt (keymap);
|
||
|
||
/* Make that be the pane title of the first pane. */
|
||
if (!NILP (prompt) && menu_items_n_panes >= 0)
|
||
XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
|
||
#endif
|
||
}
|
||
else if (!NILP (tem))
|
||
{
|
||
/* 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; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
|
||
{
|
||
Lisp_Object prompt;
|
||
|
||
maps[i++] = keymap = get_keymap (Fcar (tem));
|
||
#if 0
|
||
prompt = map_prompt (keymap);
|
||
if (NILP (title) && !NILP (prompt))
|
||
title = prompt;
|
||
#endif
|
||
}
|
||
|
||
/* Extract the detailed info to make one pane. */
|
||
hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
|
||
|
||
#if 0
|
||
/* Make the title be the pane title of the first pane. */
|
||
if (!NILP (title) && menu_items_n_panes >= 0)
|
||
XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
|
||
#endif
|
||
}
|
||
else
|
||
{
|
||
/* We were given an old-fashioned menu. */
|
||
title = Fcar (menu);
|
||
CHECK_STRING (title, 1);
|
||
|
||
hmenu = list_of_panes (lpmm, Fcdr (menu));
|
||
}
|
||
|
||
return (hmenu);
|
||
}
|
||
|
||
/* 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,
|
||
don't bother really computing whether an item is enabled. */
|
||
|
||
Lisp_Object
|
||
get_single_keymap_event (keymap, lpnum)
|
||
Lisp_Object keymap;
|
||
int * lpnum;
|
||
{
|
||
Lisp_Object pending_maps;
|
||
Lisp_Object tail, item, item1, item_string, table;
|
||
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
||
|
||
pending_maps = Qnil;
|
||
|
||
for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
|
||
{
|
||
/* Look at each key binding, and if it has a menu string,
|
||
make a menu item from it. */
|
||
|
||
item = XCONS (tail)->car;
|
||
|
||
if (XTYPE (item) == Lisp_Cons)
|
||
{
|
||
item1 = XCONS (item)->cdr;
|
||
|
||
if (CONSP (item1))
|
||
{
|
||
item_string = XCONS (item1)->car;
|
||
if (XTYPE (item_string) == Lisp_String)
|
||
{
|
||
/* This is the real definition--the function to run. */
|
||
|
||
Lisp_Object def;
|
||
|
||
/* These are the saved equivalent keyboard key sequence
|
||
and its key-description. */
|
||
|
||
Lisp_Object descrip;
|
||
Lisp_Object tem, enabled;
|
||
|
||
/* GCPRO because ...enabled_p will call eval
|
||
and ..._equiv_key may autoload something.
|
||
Protecting KEYMAP preserves everything we use;
|
||
aside from that, must protect whatever might be
|
||
a string. Since there's no GCPRO5, we refetch
|
||
item_string instead of protecting it. */
|
||
|
||
descrip = def = Qnil;
|
||
GCPRO3 (keymap, pending_maps, def);
|
||
|
||
def = menu_item_equiv_key (item_string, item1, &descrip);
|
||
|
||
UNGCPRO;
|
||
|
||
item_string = XCONS (item1)->car;
|
||
|
||
tem = Fkeymapp (def);
|
||
if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
|
||
{
|
||
pending_maps = Fcons (Fcons (def,
|
||
Fcons (item_string,
|
||
XCONS (item)->car)),
|
||
pending_maps);
|
||
}
|
||
else
|
||
{
|
||
Lisp_Object submap;
|
||
|
||
GCPRO5 (keymap, pending_maps, item, item_string, descrip);
|
||
|
||
submap = get_keymap_1 (def, 0, 1);
|
||
|
||
UNGCPRO;
|
||
|
||
if (NILP (submap))
|
||
{
|
||
if (--(*lpnum) == 0)
|
||
{
|
||
return (Fcons (XCONS (item)->car, Qnil));
|
||
}
|
||
}
|
||
else
|
||
/* Display a submenu. */
|
||
{
|
||
Lisp_Object event = get_single_keymap_event (submap,
|
||
lpnum);
|
||
|
||
if (*lpnum <= 0)
|
||
{
|
||
if (!NILP (XCONS (item)->car))
|
||
event = Fcons (XCONS (item)->car, event);
|
||
|
||
return (event);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
else if (VECTORP (item))
|
||
{
|
||
/* Loop over the char values represented in the vector. */
|
||
int len = XVECTOR (item)->size;
|
||
int c;
|
||
for (c = 0; c < len; c++)
|
||
{
|
||
Lisp_Object character;
|
||
XSETFASTINT (character, c);
|
||
item1 = XVECTOR (item)->contents[c];
|
||
if (XTYPE (item1) == Lisp_Cons)
|
||
{
|
||
item_string = XCONS (item1)->car;
|
||
if (XTYPE (item_string) == Lisp_String)
|
||
{
|
||
Lisp_Object def;
|
||
|
||
/* These are the saved equivalent keyboard key sequence
|
||
and its key-description. */
|
||
Lisp_Object descrip;
|
||
Lisp_Object tem, enabled;
|
||
|
||
/* GCPRO because ...enabled_p will call eval
|
||
and ..._equiv_key may autoload something.
|
||
Protecting KEYMAP preserves everything we use;
|
||
aside from that, must protect whatever might be
|
||
a string. Since there's no GCPRO5, we refetch
|
||
item_string instead of protecting it. */
|
||
GCPRO3 (keymap, pending_maps, def);
|
||
descrip = def = Qnil;
|
||
|
||
def = menu_item_equiv_key (item_string, item1, &descrip);
|
||
|
||
UNGCPRO;
|
||
|
||
item_string = XCONS (item1)->car;
|
||
|
||
tem = Fkeymapp (def);
|
||
if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
|
||
pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
|
||
pending_maps);
|
||
else
|
||
{
|
||
Lisp_Object submap;
|
||
|
||
GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
|
||
|
||
submap = get_keymap_1 (def, 0, 1);
|
||
|
||
UNGCPRO;
|
||
|
||
if (NILP (submap))
|
||
{
|
||
if (--(*lpnum) == 0)
|
||
{
|
||
return (Fcons (character, Qnil));
|
||
}
|
||
}
|
||
else
|
||
/* Display a submenu. */
|
||
{
|
||
Lisp_Object event = get_single_keymap_event (submap,
|
||
lpnum);
|
||
|
||
if (*lpnum <= 0)
|
||
{
|
||
if (!NILP (character))
|
||
event = Fcons (character, event);
|
||
|
||
return (event);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
/* 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 = XCONS (elt)->cdr;
|
||
string = XCONS (eltcdr)->car;
|
||
/* We no longer discard the @ from the beginning of the string here.
|
||
Instead, we do this in w32menu_show. */
|
||
{
|
||
Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
|
||
|
||
if (*lpnum <= 0)
|
||
{
|
||
if (!NILP (XCONS (eltcdr)->cdr))
|
||
event = Fcons (XCONS (eltcdr)->cdr, event);
|
||
|
||
return (event);
|
||
}
|
||
}
|
||
|
||
pending_maps = Fcdr (pending_maps);
|
||
}
|
||
|
||
return (Qnil);
|
||
}
|
||
|
||
/* 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 Lisp_Object
|
||
get_keymap_event (keymaps, nmaps, lpnum)
|
||
Lisp_Object *keymaps;
|
||
int nmaps;
|
||
int * lpnum;
|
||
{
|
||
int mapno;
|
||
Lisp_Object event = Qnil;
|
||
|
||
/* 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++)
|
||
{
|
||
event = get_single_keymap_event (keymaps[mapno], lpnum);
|
||
|
||
if (*lpnum <= 0) break;
|
||
}
|
||
|
||
return (event);
|
||
}
|
||
|
||
static Lisp_Object
|
||
get_list_of_items_event (pane, lpnum)
|
||
Lisp_Object pane;
|
||
int * lpnum;
|
||
{
|
||
Lisp_Object tail, item, item1;
|
||
|
||
for (tail = pane; !NILP (tail); tail = Fcdr (tail))
|
||
{
|
||
item = Fcar (tail);
|
||
if (STRINGP (item))
|
||
{
|
||
if (-- (*lpnum) == 0)
|
||
{
|
||
return (Qnil);
|
||
}
|
||
}
|
||
else if (!NILP (item))
|
||
{
|
||
if (--(*lpnum) == 0)
|
||
{
|
||
CHECK_CONS (item, 0);
|
||
return (Fcdr (item));
|
||
}
|
||
}
|
||
}
|
||
|
||
return (Qnil);
|
||
}
|
||
|
||
/* 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 Lisp_Object
|
||
get_list_of_panes_event (menu, lpnum)
|
||
Lisp_Object menu;
|
||
int * lpnum;
|
||
{
|
||
Lisp_Object tail;
|
||
|
||
for (tail = menu; !NILP (tail); tail = Fcdr (tail))
|
||
{
|
||
Lisp_Object elt, pane_name, pane_data;
|
||
Lisp_Object event;
|
||
|
||
elt = Fcar (tail);
|
||
pane_data = Fcdr (elt);
|
||
CHECK_CONS (pane_data, 0);
|
||
|
||
event = get_list_of_items_event (pane_data, lpnum);
|
||
|
||
if (*lpnum <= 0)
|
||
{
|
||
return (event);
|
||
}
|
||
}
|
||
|
||
return (Qnil);
|
||
}
|
||
|
||
Lisp_Object
|
||
get_menu_event (menu, lpnum)
|
||
Lisp_Object menu;
|
||
int * lpnum;
|
||
{
|
||
Lisp_Object keymap, tem;
|
||
Lisp_Object event;
|
||
|
||
/* Decode the menu items from what was specified. */
|
||
|
||
keymap = Fkeymapp (menu);
|
||
tem = Qnil;
|
||
if (XTYPE (menu) == Lisp_Cons)
|
||
tem = Fkeymapp (Fcar (menu));
|
||
|
||
if (!NILP (keymap))
|
||
{
|
||
keymap = get_keymap (menu);
|
||
|
||
event = get_keymap_event (&keymap, 1, lpnum);
|
||
}
|
||
else if (!NILP (tem))
|
||
{
|
||
/* We were given a list of keymaps. */
|
||
int nmaps = XFASTINT (Flength (menu));
|
||
Lisp_Object *maps
|
||
= (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
|
||
int i;
|
||
|
||
/* The first keymap that has a prompt string
|
||
supplies the menu title. */
|
||
for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
|
||
{
|
||
Lisp_Object prompt;
|
||
|
||
maps[i++] = keymap = get_keymap (Fcar (tem));
|
||
}
|
||
|
||
event = get_keymap_event (maps, nmaps, lpnum);
|
||
}
|
||
else
|
||
{
|
||
/* We were given an old-fashioned menu. */
|
||
event = get_list_of_panes_event (Fcdr (menu), lpnum);
|
||
}
|
||
|
||
return (event);
|
||
}
|
||
|
||
DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
|
||
"Pop up a deck-of-cards menu and return user's selection.\n\
|
||
POSITION is a position specification. This is either a mouse button event\n\
|
||
or a list ((XOFFSET YOFFSET) WINDOW)\n\
|
||
where XOFFSET and YOFFSET are positions in pixels from the top left\n\
|
||
corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
|
||
This controls the position of the center of the first line\n\
|
||
in the first pane of the menu, not the top left of the menu as a whole.\n\
|
||
If POSITION is t, it means to use the current mouse position.\n\
|
||
\n\
|
||
MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
|
||
The menu items come from key bindings that have a menu string as well as\n\
|
||
a definition; actually, the \"definition\" in such a key binding looks like\n\
|
||
\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
|
||
the keymap as a top-level element.\n\n\
|
||
You can also use a list of keymaps as MENU.\n\
|
||
Then each keymap makes a separate pane.\n\
|
||
When MENU is a keymap or a list of keymaps, the return value\n\
|
||
is a list of events.\n\n\
|
||
Alternatively, you can specify a menu of multiple panes\n\
|
||
with a list of the form (TITLE PANE1 PANE2...),\n\
|
||
where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
|
||
Each ITEM is normally a cons cell (STRING . VALUE);\n\
|
||
but a string can appear as an item--that makes a nonselectable line\n\
|
||
in the menu.\n\
|
||
With this form of menu, the return value is VALUE from the chosen item.\n\
|
||
\n\
|
||
If POSITION is nil, don't display the menu at all, just precalculate the\n\
|
||
cached information about equivalent key sequences.")
|
||
(position, menu)
|
||
Lisp_Object position, menu;
|
||
{
|
||
int number_of_panes, panes;
|
||
Lisp_Object keymap, tem;
|
||
int xpos, ypos;
|
||
Lisp_Object title;
|
||
char *error_name;
|
||
Lisp_Object selection;
|
||
int i, j;
|
||
FRAME_PTR f;
|
||
Lisp_Object x, y, window;
|
||
int keymaps = 0;
|
||
int menubarp = 0;
|
||
struct gcpro gcpro1;
|
||
HMENU hmenu;
|
||
menu_map mm;
|
||
|
||
if (! NILP (position))
|
||
{
|
||
/* Decode the first argument: find the window and the coordinates. */
|
||
if (EQ (position, Qt)
|
||
|| (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
|
||
{
|
||
/* Use the mouse's current position. */
|
||
FRAME_PTR new_f = selected_frame;
|
||
Lisp_Object bar_window;
|
||
int part;
|
||
unsigned long time;
|
||
|
||
if (mouse_position_hook)
|
||
(*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
|
||
{
|
||
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);
|
||
|
||
/* Determine whether this menu is handling a menu bar click. */
|
||
tem = Fcar (Fcdr (Fcar (Fcdr (position))));
|
||
if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
|
||
menubarp = 1;
|
||
}
|
||
}
|
||
|
||
CHECK_NUMBER (x, 0);
|
||
CHECK_NUMBER (y, 0);
|
||
|
||
/* Decode where to put the menu. */
|
||
|
||
if (FRAMEP (window))
|
||
{
|
||
f = XFRAME (window);
|
||
|
||
xpos = 0;
|
||
ypos = 0;
|
||
}
|
||
else if (WINDOWP (window))
|
||
{
|
||
CHECK_LIVE_WINDOW (window, 0);
|
||
f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
|
||
|
||
xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left);
|
||
ypos = (f->output_data.w32->line_height * XWINDOW (window)->top);
|
||
}
|
||
else
|
||
/* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
|
||
but I don't want to make one now. */
|
||
CHECK_WINDOW (window, 0);
|
||
|
||
xpos += XINT (x);
|
||
ypos += XINT (y);
|
||
}
|
||
|
||
title = Qnil;
|
||
GCPRO1 (title);
|
||
|
||
discard_menu_items (&mm);
|
||
hmenu = create_menu_items (&mm, menu, NILP (position));
|
||
|
||
if (NILP (position))
|
||
{
|
||
discard_menu_items (&mm);
|
||
UNGCPRO;
|
||
return Qnil;
|
||
}
|
||
|
||
/* Display them in a menu. */
|
||
BLOCK_INPUT;
|
||
|
||
selection = w32menu_show (f, xpos, ypos, menu, hmenu, &error_name);
|
||
|
||
UNBLOCK_INPUT;
|
||
|
||
discard_menu_items (&mm);
|
||
DestroyMenu (hmenu);
|
||
|
||
UNGCPRO;
|
||
|
||
if (error_name) error (error_name);
|
||
return selection;
|
||
}
|
||
|
||
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
|
||
"Pop up a dialog box and return user's selection.\n\
|
||
POSITION specifies which frame to use.\n\
|
||
This is normally a mouse button event or a window or frame.\n\
|
||
If POSITION is t, it means to use the frame the mouse is on.\n\
|
||
The dialog box appears in the middle of the specified frame.\n\
|
||
\n\
|
||
CONTENTS specifies the alternatives to display in the dialog box.\n\
|
||
It is a list of the form (TITLE ITEM1 ITEM2...).\n\
|
||
Each ITEM is a cons cell (STRING . VALUE).\n\
|
||
The return value is VALUE from the chosen item.\n\n\
|
||
An ITEM may also be just a string--that makes a nonselectable item.\n\
|
||
An ITEM may also be nil--that means to put all preceding items\n\
|
||
on the left of the dialog box and all following items on the right.\n\
|
||
\(By default, approximately half appear on each side.)")
|
||
(position, contents)
|
||
Lisp_Object position, contents;
|
||
{
|
||
FRAME_PTR f;
|
||
Lisp_Object window;
|
||
|
||
/* Decode the first argument: find the window or frame to use. */
|
||
if (EQ (position, Qt))
|
||
{
|
||
/* Decode the first argument: find the window and the coordinates. */
|
||
if (EQ (position, Qt))
|
||
window = selected_window;
|
||
}
|
||
else if (CONSP (position))
|
||
{
|
||
Lisp_Object tem;
|
||
tem = Fcar (position);
|
||
if (XTYPE (tem) == Lisp_Cons)
|
||
window = Fcar (Fcdr (position));
|
||
else
|
||
{
|
||
tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
|
||
window = Fcar (tem); /* POSN_WINDOW (tem) */
|
||
}
|
||
}
|
||
else if (WINDOWP (position) || FRAMEP (position))
|
||
window = position;
|
||
|
||
/* Decode where to put the menu. */
|
||
|
||
if (FRAMEP (window))
|
||
f = XFRAME (window);
|
||
else if (WINDOWP (window))
|
||
{
|
||
CHECK_LIVE_WINDOW (window, 0);
|
||
f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
|
||
}
|
||
else
|
||
/* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
|
||
but I don't want to make one now. */
|
||
CHECK_WINDOW (window, 0);
|
||
|
||
#if 1
|
||
/* 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
|
||
{
|
||
Lisp_Object title;
|
||
char *error_name;
|
||
Lisp_Object selection;
|
||
|
||
/* Decode the dialog items from what was specified. */
|
||
title = Fcar (contents);
|
||
CHECK_STRING (title, 1);
|
||
|
||
list_of_panes (Fcons (contents, Qnil));
|
||
|
||
/* Display them in a dialog box. */
|
||
BLOCK_INPUT;
|
||
selection = w32_dialog_show (f, 0, 0, title, &error_name);
|
||
UNBLOCK_INPUT;
|
||
|
||
discard_menu_items ();
|
||
|
||
if (error_name) error (error_name);
|
||
return selection;
|
||
}
|
||
#endif
|
||
}
|
||
|
||
Lisp_Object
|
||
get_frame_menubar_event (f, num)
|
||
FRAME_PTR f;
|
||
int num;
|
||
{
|
||
Lisp_Object tail, items;
|
||
int i;
|
||
struct gcpro gcpro1;
|
||
|
||
BLOCK_INPUT;
|
||
|
||
GCPRO1 (items);
|
||
|
||
if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
|
||
items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
|
||
|
||
for (i = 0; i < XVECTOR (items)->size; i += 4)
|
||
{
|
||
Lisp_Object event, binding;
|
||
binding = XVECTOR (items)->contents[i + 2];
|
||
|
||
/* Check to see if this might be a menubar button. It might be
|
||
if it is not a keymap, it is a cons cell, its car is not a
|
||
keymap, and its cdr is nil. */
|
||
if (NILP (Fkeymapp (binding))
|
||
&& CONSP (binding)
|
||
&& NILP (Fkeymapp (XCONS (binding)->car))
|
||
&& NILP (XCONS (binding)->cdr))
|
||
{
|
||
/* The fact that we have to check that this is a string here
|
||
is the reason we don't do all this rigamarole in
|
||
get_menu_event. */
|
||
if (XTYPE (XVECTOR (items)->contents[i + 1]) == Lisp_String)
|
||
{
|
||
/* This was a menubar button. */
|
||
if (--num <= 0)
|
||
{
|
||
UNGCPRO;
|
||
UNBLOCK_INPUT;
|
||
return (Fcons (XVECTOR (items)->contents[i], Qnil));
|
||
}
|
||
}
|
||
}
|
||
else
|
||
{
|
||
event = get_menu_event (binding, &num);
|
||
|
||
if (num <= 0)
|
||
{
|
||
UNGCPRO;
|
||
UNBLOCK_INPUT;
|
||
return (Fcons (XVECTOR (items)->contents[i], event));
|
||
}
|
||
}
|
||
}
|
||
|
||
UNGCPRO;
|
||
UNBLOCK_INPUT;
|
||
|
||
return (Qnil);
|
||
}
|
||
|
||
/* 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. */
|
||
|
||
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);
|
||
}
|
||
|
||
void
|
||
set_frame_menubar (f, first_time, deep_p)
|
||
FRAME_PTR f;
|
||
int first_time;
|
||
int deep_p;
|
||
{
|
||
Lisp_Object tail, items;
|
||
HMENU hmenu;
|
||
int i;
|
||
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
||
menu_map mm;
|
||
int count = specpdl_ptr - specpdl;
|
||
|
||
struct buffer *prev = current_buffer;
|
||
Lisp_Object buffer;
|
||
|
||
/* We must not change the menubar when actually in use. */
|
||
if (f->output_data.w32->menubar_active)
|
||
return;
|
||
|
||
#if 0 /* I don't see why this should be needed */
|
||
/* Ensure menubar is up to date when about to be used. */
|
||
if (f->output_data.w32->pending_menu_activation && !deep_p)
|
||
deep_p = 1;
|
||
#endif
|
||
|
||
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
|
||
specbind (Qinhibit_quit, Qt);
|
||
/* Don't let the debugger step into this code
|
||
because it is not reentrant. */
|
||
specbind (Qdebug_on_next_call, Qnil);
|
||
|
||
record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil));
|
||
if (NILP (Voverriding_local_map_menu_flag))
|
||
{
|
||
specbind (Qoverriding_terminal_local_map, Qnil);
|
||
specbind (Qoverriding_local_map, Qnil);
|
||
}
|
||
|
||
set_buffer_internal_1 (XBUFFER (buffer));
|
||
|
||
/* Run the Lucid hook. */
|
||
call1 (Vrun_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);
|
||
|
||
BLOCK_INPUT;
|
||
|
||
GCPRO1 (items);
|
||
|
||
items = FRAME_MENU_BAR_ITEMS (f);
|
||
if (NILP (items))
|
||
items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
|
||
|
||
hmenu = f->output_data.w32->menubar_widget;
|
||
if (!hmenu)
|
||
{
|
||
hmenu = CreateMenu ();
|
||
if (!hmenu) goto error;
|
||
}
|
||
else
|
||
{
|
||
/* Delete current contents. */
|
||
while (DeleteMenu (hmenu, 0, MF_BYPOSITION))
|
||
;
|
||
}
|
||
|
||
discard_menu_items (&mm);
|
||
UNBLOCK_INPUT;
|
||
|
||
for (i = 0; i < XVECTOR (items)->size; i += 4)
|
||
{
|
||
Lisp_Object string, binding;
|
||
int keymaps;
|
||
CHAR *error;
|
||
HMENU new_hmenu;
|
||
|
||
string = XVECTOR (items)->contents[i + 1];
|
||
if (NILP (string))
|
||
break;
|
||
|
||
binding = XVECTOR (items)->contents[i + 2];
|
||
|
||
if (NILP (Fkeymapp (binding))
|
||
&& CONSP (binding)
|
||
&& NILP (Fkeymapp (XCONS (binding)->car))
|
||
&& NILP (XCONS (binding)->cdr))
|
||
{
|
||
/* This is a menubar button. */
|
||
Lisp_Object descrip, def;
|
||
Lisp_Object enabled, item;
|
||
item = Fcons (string, Fcar (binding));
|
||
descrip = def = Qnil;
|
||
UNGCPRO;
|
||
GCPRO4 (items, item, def, string);
|
||
|
||
def = menu_item_equiv_key (string, item, &descrip);
|
||
enabled = menu_item_enabled_p (def, 0);
|
||
|
||
UNGCPRO;
|
||
GCPRO1 (items);
|
||
|
||
add_menu_item (&mm, hmenu, string, enabled, def, Qnil);
|
||
}
|
||
else
|
||
{
|
||
/* Input must not be blocked here because we call general
|
||
Lisp code and internal_condition_case_1. */
|
||
new_hmenu = create_menu_items (&mm, binding, 0);
|
||
|
||
if (!new_hmenu)
|
||
continue;
|
||
|
||
BLOCK_INPUT;
|
||
AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
|
||
(char *) XSTRING (string)->data);
|
||
UNBLOCK_INPUT;
|
||
}
|
||
}
|
||
|
||
BLOCK_INPUT;
|
||
{
|
||
HMENU old = f->output_data.w32->menubar_widget;
|
||
SetMenu (FRAME_W32_WINDOW (f), hmenu);
|
||
f->output_data.w32->menubar_widget = hmenu;
|
||
/* Causes flicker when menu bar is updated
|
||
DrawMenuBar (FRAME_W32_WINDOW (f)); */
|
||
|
||
/* Force the window size to be recomputed so that the frame's text
|
||
area remains the same, if menubar has just been created. */
|
||
if (old == NULL)
|
||
x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
|
||
}
|
||
|
||
error:
|
||
set_buffer_internal_1 (prev);
|
||
UNGCPRO;
|
||
UNBLOCK_INPUT;
|
||
unbind_to (count, Qnil);
|
||
}
|
||
|
||
void
|
||
free_frame_menubar (f)
|
||
FRAME_PTR f;
|
||
{
|
||
BLOCK_INPUT;
|
||
|
||
{
|
||
HMENU old = GetMenu (FRAME_W32_WINDOW (f));
|
||
SetMenu (FRAME_W32_WINDOW (f), NULL);
|
||
f->output_data.w32->menubar_widget = NULL;
|
||
DestroyMenu (old);
|
||
}
|
||
|
||
UNBLOCK_INPUT;
|
||
}
|
||
/* Called from Fw32_create_frame to create the initial menubar of a frame
|
||
before it is mapped, so that the window is mapped with the menubar already
|
||
there instead of us tacking it on later and thrashing the window after it
|
||
is visible. */
|
||
void
|
||
initialize_frame_menubar (f)
|
||
FRAME_PTR f;
|
||
{
|
||
set_frame_menubar (f, 1, 1);
|
||
}
|
||
|
||
#if 0
|
||
/* If the mouse has moved to another menu bar item,
|
||
return 1 and unread a button press event for that item.
|
||
Otherwise return 0. */
|
||
|
||
static int
|
||
check_mouse_other_menu_bar (f)
|
||
FRAME_PTR f;
|
||
{
|
||
FRAME_PTR new_f;
|
||
Lisp_Object bar_window;
|
||
int part;
|
||
Lisp_Object x, y;
|
||
unsigned long time;
|
||
|
||
(*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
|
||
|
||
if (f == new_f && other_menu_bar_item_p (f, x, y))
|
||
{
|
||
unread_menu_bar_button (f, x);
|
||
return 1;
|
||
}
|
||
|
||
return 0;
|
||
}
|
||
#endif
|
||
|
||
|
||
#if 0
|
||
static HMENU
|
||
create_menu (keymaps, error)
|
||
int keymaps;
|
||
char **error;
|
||
{
|
||
HMENU hmenu = NULL; /* the menu we are currently working on */
|
||
HMENU first_hmenu = NULL;
|
||
|
||
HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
|
||
Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
|
||
sizeof (Lisp_Object));
|
||
int submenu_depth = 0;
|
||
int i;
|
||
|
||
if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
|
||
{
|
||
*error = "Empty menu";
|
||
return NULL;
|
||
}
|
||
|
||
i = 0;
|
||
|
||
/* Loop over all panes and items, filling in the tree. */
|
||
|
||
while (i < menu_items_used)
|
||
{
|
||
if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
|
||
{
|
||
submenu_stack[submenu_depth++] = hmenu;
|
||
i++;
|
||
}
|
||
else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
|
||
{
|
||
hmenu = submenu_stack[--submenu_depth];
|
||
i++;
|
||
}
|
||
#if 0
|
||
else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
|
||
&& submenu_depth != 0)
|
||
i += MENU_ITEMS_PANE_LENGTH;
|
||
#endif
|
||
/* Ignore a nil in the item list.
|
||
It's meaningful only for dialog boxes. */
|
||
else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
|
||
i += 1;
|
||
else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
|
||
{
|
||
/* Create a new pane. */
|
||
|
||
Lisp_Object pane_name;
|
||
char *pane_string;
|
||
|
||
pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
|
||
pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
|
||
|
||
if (!hmenu || strcmp (pane_string, ""))
|
||
{
|
||
HMENU new_hmenu = CreatePopupMenu ();
|
||
|
||
if (!new_hmenu)
|
||
{
|
||
*error = "Could not create menu pane";
|
||
goto error;
|
||
}
|
||
|
||
if (hmenu)
|
||
{
|
||
AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
|
||
}
|
||
|
||
hmenu = new_hmenu;
|
||
|
||
if (!first_hmenu) first_hmenu = hmenu;
|
||
}
|
||
i += MENU_ITEMS_PANE_LENGTH;
|
||
}
|
||
else
|
||
{
|
||
/* Create a new item within current pane. */
|
||
|
||
Lisp_Object item_name, enable, descrip;
|
||
UINT fuFlags;
|
||
|
||
item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
|
||
enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
|
||
// descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
|
||
|
||
if (name_is_separator (item_name))
|
||
fuFlags = MF_SEPARATOR;
|
||
else if (NILP (enable) || !XUINT (enable))
|
||
fuFlags = MF_STRING | MF_GRAYED;
|
||
else
|
||
fuFlags = MF_STRING;
|
||
|
||
AppendMenu (hmenu,
|
||
fuFlags,
|
||
i,
|
||
(char *) XSTRING (item_name)->data);
|
||
|
||
// if (!NILP (descrip))
|
||
// hmenu->key = (char *) XSTRING (descrip)->data;
|
||
|
||
i += MENU_ITEMS_ITEM_LENGTH;
|
||
}
|
||
}
|
||
|
||
return (first_hmenu);
|
||
|
||
error:
|
||
if (first_hmenu) DestroyMenu (first_hmenu);
|
||
return (NULL);
|
||
}
|
||
|
||
#endif
|
||
|
||
/* w32menu_show actually displays a menu using the panes and items in
|
||
menu_items and returns the value selected from it.
|
||
There are two versions of w32menu_show, one for Xt and one for Xlib.
|
||
Both assume input is blocked by the caller. */
|
||
|
||
/* F is the frame the menu is for.
|
||
X and Y are the frame-relative specified position,
|
||
relative to the inside upper left corner of the frame F.
|
||
MENUBARP is 1 if the click that asked for this menu came from the menu bar.
|
||
KEYMAPS is 1 if this menu was specified with keymaps;
|
||
in that case, we return a list containing the chosen item's value
|
||
and perhaps also the pane's prefix.
|
||
TITLE is the specified menu title.
|
||
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
|
||
w32menu_show (f, x, y, menu, hmenu, error)
|
||
FRAME_PTR f;
|
||
int x;
|
||
int y;
|
||
Lisp_Object menu;
|
||
HMENU hmenu;
|
||
char **error;
|
||
{
|
||
int i , menu_selection;
|
||
POINT pos;
|
||
|
||
*error = NULL;
|
||
|
||
if (!hmenu)
|
||
{
|
||
*error = "Empty menu";
|
||
return Qnil;
|
||
}
|
||
|
||
pos.x = x;
|
||
pos.y = y;
|
||
|
||
/* Offset the coordinates to root-relative. */
|
||
ClientToScreen (FRAME_W32_WINDOW (f), &pos);
|
||
|
||
#if 0
|
||
/* If the mouse moves out of the menu before we show the menu,
|
||
don't show it at all. */
|
||
if (check_mouse_other_menu_bar (f))
|
||
{
|
||
DestroyMenu (hmenu);
|
||
return Qnil;
|
||
}
|
||
#endif
|
||
|
||
/* Display the menu. */
|
||
menu_selection = SendMessage (FRAME_W32_WINDOW (f),
|
||
WM_EMACS_TRACKPOPUPMENU,
|
||
(WPARAM)hmenu, (LPARAM)&pos);
|
||
|
||
/* Clean up extraneous mouse events which might have been generated
|
||
during the call. */
|
||
discard_mouse_events ();
|
||
|
||
if (menu_selection == -1)
|
||
{
|
||
*error = "Invalid menu specification";
|
||
return Qnil;
|
||
}
|
||
|
||
/* Find the selected item, and its pane, to return
|
||
the proper value. */
|
||
|
||
#if 1
|
||
if (menu_selection > 0)
|
||
{
|
||
return get_menu_event (menu, &menu_selection);
|
||
}
|
||
#else
|
||
if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
|
||
{
|
||
return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
|
||
}
|
||
#endif
|
||
|
||
return Qnil;
|
||
}
|
||
|
||
#if 0
|
||
static char * button_names [] =
|
||
{
|
||
"button1", "button2", "button3", "button4", "button5",
|
||
"button6", "button7", "button8", "button9", "button10"
|
||
};
|
||
|
||
static Lisp_Object
|
||
w32_dialog_show (f, menubarp, keymaps, title, error)
|
||
FRAME_PTR f;
|
||
int menubarp;
|
||
int keymaps;
|
||
Lisp_Object title;
|
||
char **error;
|
||
{
|
||
int i, nb_buttons=0;
|
||
HMENU hmenu;
|
||
char dialog_name[6];
|
||
|
||
/* Number of elements seen so far, before boundary. */
|
||
int left_count = 0;
|
||
/* 1 means we've seen the boundary between left-hand elts and right-hand. */
|
||
int boundary_seen = 0;
|
||
|
||
*error = NULL;
|
||
|
||
if (menu_items_n_panes > 1)
|
||
{
|
||
*error = "Multiple panes in dialog box";
|
||
return Qnil;
|
||
}
|
||
|
||
/* Create a tree of widget_value objects
|
||
representing the text label and buttons. */
|
||
{
|
||
Lisp_Object pane_name, prefix;
|
||
char *pane_string;
|
||
pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
|
||
prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
|
||
pane_string = (NILP (pane_name)
|
||
? "" : (char *) XSTRING (pane_name)->data);
|
||
prev_wv = malloc_widget_value ();
|
||
prev_wv->value = pane_string;
|
||
if (keymaps && !NILP (prefix))
|
||
prev_wv->name++;
|
||
prev_wv->enabled = 1;
|
||
prev_wv->name = "message";
|
||
first_wv = prev_wv;
|
||
|
||
/* Loop over all panes and items, filling in the tree. */
|
||
i = MENU_ITEMS_PANE_LENGTH;
|
||
while (i < menu_items_used)
|
||
{
|
||
|
||
/* Create a new item within current pane. */
|
||
Lisp_Object item_name, enable, descrip;
|
||
item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
|
||
enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
|
||
descrip
|
||
= XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
|
||
|
||
if (NILP (item_name))
|
||
{
|
||
free_menubar_widget_value_tree (first_wv);
|
||
*error = "Submenu in dialog items";
|
||
return Qnil;
|
||
}
|
||
if (EQ (item_name, Qquote))
|
||
{
|
||
/* This is the boundary between left-side elts
|
||
and right-side elts. Stop incrementing right_count. */
|
||
boundary_seen = 1;
|
||
i++;
|
||
continue;
|
||
}
|
||
if (nb_buttons >= 10)
|
||
{
|
||
free_menubar_widget_value_tree (first_wv);
|
||
*error = "Too many dialog items";
|
||
return Qnil;
|
||
}
|
||
|
||
wv = malloc_widget_value ();
|
||
prev_wv->next = wv;
|
||
wv->name = (char *) button_names[nb_buttons];
|
||
if (!NILP (descrip))
|
||
wv->key = (char *) XSTRING (descrip)->data;
|
||
wv->value = (char *) XSTRING (item_name)->data;
|
||
wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
|
||
wv->enabled = !NILP (enable);
|
||
prev_wv = wv;
|
||
|
||
if (! boundary_seen)
|
||
left_count++;
|
||
|
||
nb_buttons++;
|
||
i += MENU_ITEMS_ITEM_LENGTH;
|
||
}
|
||
|
||
/* If the boundary was not specified,
|
||
by default put half on the left and half on the right. */
|
||
if (! boundary_seen)
|
||
left_count = nb_buttons - nb_buttons / 2;
|
||
|
||
wv = malloc_widget_value ();
|
||
wv->name = dialog_name;
|
||
|
||
/* Dialog boxes use a really stupid name encoding
|
||
which specifies how many buttons to use
|
||
and how many buttons are on the right.
|
||
The Q means something also. */
|
||
dialog_name[0] = 'Q';
|
||
dialog_name[1] = '0' + nb_buttons;
|
||
dialog_name[2] = 'B';
|
||
dialog_name[3] = 'R';
|
||
/* Number of buttons to put on the right. */
|
||
dialog_name[4] = '0' + nb_buttons - left_count;
|
||
dialog_name[5] = 0;
|
||
wv->contents = first_wv;
|
||
first_wv = wv;
|
||
}
|
||
|
||
/* Actually create the dialog. */
|
||
dialog_id = ++popup_id_tick;
|
||
menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
|
||
f->output_data.w32->widget, 1, 0,
|
||
dialog_selection_callback, 0);
|
||
#if 0 /* This causes crashes, and seems to be redundant -- rms. */
|
||
lw_modify_all_widgets (dialog_id, first_wv, True);
|
||
#endif
|
||
lw_modify_all_widgets (dialog_id, first_wv->contents, True);
|
||
/* Free the widget_value objects we used to specify the contents. */
|
||
free_menubar_widget_value_tree (first_wv);
|
||
|
||
/* No selection has been chosen yet. */
|
||
menu_item_selection = 0;
|
||
|
||
/* Display the menu. */
|
||
lw_pop_up_all_widgets (dialog_id);
|
||
|
||
/* Process events that apply to the menu. */
|
||
while (1)
|
||
{
|
||
XEvent event;
|
||
|
||
XtAppNextEvent (Xt_app_con, &event);
|
||
if (event.type == ButtonRelease)
|
||
{
|
||
XtDispatchEvent (&event);
|
||
break;
|
||
}
|
||
else if (event.type == Expose)
|
||
process_expose_from_menu (event);
|
||
XtDispatchEvent (&event);
|
||
if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
|
||
{
|
||
queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
|
||
|
||
if (queue_tmp != NULL)
|
||
{
|
||
queue_tmp->event = event;
|
||
queue_tmp->next = queue;
|
||
queue = queue_tmp;
|
||
}
|
||
}
|
||
}
|
||
pop_down:
|
||
|
||
/* State that no mouse buttons are now held.
|
||
That is not necessarily true, but the fiction leads to reasonable
|
||
results, and it is a pain to ask which are actually held now
|
||
or track this in the loop above. */
|
||
w32_mouse_grabbed = 0;
|
||
|
||
/* Unread any events that we got but did not handle. */
|
||
while (queue != NULL)
|
||
{
|
||
queue_tmp = queue;
|
||
XPutBackEvent (XDISPLAY &queue_tmp->event);
|
||
queue = queue_tmp->next;
|
||
free ((char *)queue_tmp);
|
||
/* Cause these events to get read as soon as we UNBLOCK_INPUT. */
|
||
interrupt_input_pending = 1;
|
||
}
|
||
|
||
/* Find the selected item, and its pane, to return
|
||
the proper value. */
|
||
if (menu_item_selection != 0)
|
||
{
|
||
Lisp_Object prefix;
|
||
|
||
prefix = Qnil;
|
||
i = 0;
|
||
while (i < menu_items_used)
|
||
{
|
||
Lisp_Object entry;
|
||
|
||
if (EQ (XVECTOR (menu_items)->contents[i], Qt))
|
||
{
|
||
prefix
|
||
= XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
|
||
i += MENU_ITEMS_PANE_LENGTH;
|
||
}
|
||
else
|
||
{
|
||
entry
|
||
= XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
|
||
if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
|
||
{
|
||
if (keymaps != 0)
|
||
{
|
||
entry = Fcons (entry, Qnil);
|
||
if (!NILP (prefix))
|
||
entry = Fcons (prefix, entry);
|
||
}
|
||
return entry;
|
||
}
|
||
i += MENU_ITEMS_ITEM_LENGTH;
|
||
}
|
||
}
|
||
}
|
||
|
||
return Qnil;
|
||
}
|
||
#endif
|
||
|
||
syms_of_w32menu ()
|
||
{
|
||
Qdebug_on_next_call = intern ("debug-on-next-call");
|
||
staticpro (&Qdebug_on_next_call);
|
||
|
||
defsubr (&Sx_popup_menu);
|
||
defsubr (&Sx_popup_dialog);
|
||
}
|