aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/w32menu.c2916
1 files changed, 1446 insertions, 1470 deletions
diff --git a/src/w32menu.c b/src/w32menu.c
index fe474caa1a6..4263c631bdc 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1,5 +1,5 @@
1/* Menu support for GNU Emacs on the Microsoft W32 API. 1/* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
3 3
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
@@ -18,8 +18,6 @@ along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */ 19Boston, MA 02111-1307, USA. */
20 20
21/* Written by Kevin Gallo. */
22
23#include <signal.h> 21#include <signal.h>
24#include <config.h> 22#include <config.h>
25 23
@@ -44,22 +42,88 @@ Boston, MA 02111-1307, USA. */
44 42
45#include "dispextern.h" 43#include "dispextern.h"
46 44
47#define min(x, y) (((x) < (y)) ? (x) : (y)) 45/******************************************************************/
48#define max(x, y) (((x) > (y)) ? (x) : (y)) 46/* Definitions copied from lwlib.h */
49 47
50Lisp_Object Vmenu_updating_frame; 48typedef void * XtPointer;
49typedef char Boolean;
50
51#define True 1
52#define False 0
53
54typedef enum _change_type
55{
56 NO_CHANGE = 0,
57 INVISIBLE_CHANGE = 1,
58 VISIBLE_CHANGE = 2,
59 STRUCTURAL_CHANGE = 3
60} change_type;
51 61
52typedef struct menu_map 62typedef struct _widget_value
53{ 63{
54 Lisp_Object menu_items; 64 /* name of widget */
55 int menu_items_allocated; 65 char* name;
56 int menu_items_used; 66 /* value (meaning depend on widget type) */
57} menu_map; 67 char* value;
68 /* keyboard equivalent. no implications for XtTranslations */
69 char* key;
70 /* true if enabled */
71 Boolean enabled;
72 /* true if selected */
73 Boolean selected;
74 /* true if menu title */
75 Boolean title;
76#if 0
77 /* true if was edited (maintained by get_value) */
78 Boolean edited;
79 /* true if has changed (maintained by lw library) */
80 change_type change;
81 /* true if this widget itself has changed,
82 but not counting the other widgets found in the `next' field. */
83 change_type this_one_change;
84#endif
85 /* Contents of the sub-widgets, also selected slot for checkbox */
86 struct _widget_value* contents;
87 /* data passed to callback */
88 XtPointer call_data;
89 /* next one in the list */
90 struct _widget_value* next;
91#if 0
92 /* slot for the toolkit dependent part. Always initialize to NULL. */
93 void* toolkit_data;
94 /* tell us if we should free the toolkit data slot when freeing the
95 widget_value itself. */
96 Boolean free_toolkit_data;
97
98 /* we resource the widget_value structures; this points to the next
99 one on the free list if this one has been deallocated.
100 */
101 struct _widget_value *free_list;
102#endif
103} widget_value;
104
105/* LocalAlloc/Free is a reasonably good allocator. */
106#define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
107#define free_widget_value(wv) LocalFree (wv)
108
109/******************************************************************/
110
111#define min(x,y) (((x) < (y)) ? (x) : (y))
112#define max(x,y) (((x) > (y)) ? (x) : (y))
113
114#ifndef TRUE
115#define TRUE 1
116#define FALSE 0
117#endif /* no TRUE */
118
119Lisp_Object Vmenu_updating_frame;
58 120
59Lisp_Object Qdebug_on_next_call; 121Lisp_Object Qdebug_on_next_call;
60 122
61extern Lisp_Object Qmenu_enable;
62extern Lisp_Object Qmenu_bar; 123extern Lisp_Object Qmenu_bar;
124extern Lisp_Object Qmouse_click, Qevent_kind;
125
126extern Lisp_Object QCtoggle, QCradio;
63 127
64extern Lisp_Object Voverriding_local_map; 128extern Lisp_Object Voverriding_local_map;
65extern Lisp_Object Voverriding_local_map_menu_flag; 129extern Lisp_Object Voverriding_local_map_menu_flag;
@@ -70,276 +134,227 @@ extern Lisp_Object Qmenu_bar_update_hook;
70 134
71void set_frame_menubar (); 135void set_frame_menubar ();
72 136
137static Lisp_Object w32_menu_show ();
73static Lisp_Object w32_dialog_show (); 138static Lisp_Object w32_dialog_show ();
74static Lisp_Object w32menu_show ();
75 139
76static HMENU keymap_panes (); 140static void keymap_panes ();
77static HMENU single_keymap_panes (); 141static void single_keymap_panes ();
78static HMENU list_of_panes (); 142static void single_menu_item ();
79static HMENU list_of_items (); 143static void list_of_panes ();
144static void list_of_items ();
145
146/* This holds a Lisp vector that holds the results of decoding
147 the keymaps or alist-of-alists that specify a menu.
80 148
81static HMENU create_menu_items (); 149 It describes the panes and items within the panes.
150
151 Each pane is described by 3 elements in the vector:
152 t, the pane name, the pane's prefix key.
153 Then follow the pane's items, with 5 elements per item:
154 the item string, the enable flag, the item's value,
155 the definition, and the equivalent keyboard key's description string.
156
157 In some cases, multiple levels of menus may be described.
158 A single vector slot containing nil indicates the start of a submenu.
159 A single vector slot containing lambda indicates the end of a submenu.
160 The submenu follows a menu item which is the way to reach the submenu.
161
162 A single vector slot containing quote indicates that the
163 following items should appear on the right of a dialog box.
164
165 Using a Lisp vector to hold this information while we decode it
166 takes care of protecting all the data from GC. */
167
168#define MENU_ITEMS_PANE_NAME 1
169#define MENU_ITEMS_PANE_PREFIX 2
170#define MENU_ITEMS_PANE_LENGTH 3
171
172#define MENU_ITEMS_ITEM_NAME 0
173#define MENU_ITEMS_ITEM_ENABLE 1
174#define MENU_ITEMS_ITEM_VALUE 2
175#define MENU_ITEMS_ITEM_EQUIV_KEY 3
176#define MENU_ITEMS_ITEM_DEFINITION 4
177#define MENU_ITEMS_ITEM_LENGTH 5
178
179static Lisp_Object menu_items;
180
181/* Number of slots currently allocated in menu_items. */
182static int menu_items_allocated;
183
184/* This is the index in menu_items of the first empty slot. */
185static int menu_items_used;
186
187/* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189static int menu_items_n_panes;
190
191/* Current depth within submenus. */
192static int menu_items_submenu_depth;
193
194/* Flag which when set indicates a dialog or menu has been posted by
195 Xt on behalf of one of the widget sets. */
196static int popup_activated_flag;
197
198/* This is set nonzero after the user activates the menu bar, and set
199 to zero again after the menu bars are redisplayed by prepare_menu_bar.
200 While it is nonzero, all calls to set_frame_menubar go deep.
201
202 I don't understand why this is needed, but it does seem to be
203 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
204
205int pending_menu_activation;
206
82 207
208/* Return the frame whose ->output_data.w32->menubar_widget equals
209 MENU, or 0 if none. */
210
211static struct frame *
212menubar_id_to_frame (HMENU menu)
213{
214 Lisp_Object tail, frame;
215 FRAME_PTR f;
216
217 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
218 {
219 frame = XCONS (tail)->car;
220 if (!GC_FRAMEP (frame))
221 continue;
222 f = XFRAME (frame);
223 if (f->output_data.nothing == 1)
224 continue;
225 if (f->output_data.w32->menubar_widget == menu)
226 return f;
227 }
228 return 0;
229}
230
83/* Initialize the menu_items structure if we haven't already done so. 231/* Initialize the menu_items structure if we haven't already done so.
84 Also mark it as currently empty. */ 232 Also mark it as currently empty. */
85 233
86#if 0 234static void
87static void 235init_menu_items ()
88init_menu_items (lpmm)
89 menu_map * lpmm;
90{ 236{
91 if (NILP (lpmm->menu_items)) 237 if (NILP (menu_items))
92 { 238 {
93 lpmm->menu_items_allocated = 60; 239 menu_items_allocated = 60;
94 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated), 240 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
95 Qnil);
96 } 241 }
97 242
98 lpmm->menu_items_used = 0; 243 menu_items_used = 0;
244 menu_items_n_panes = 0;
245 menu_items_submenu_depth = 0;
99} 246}
100 247
101/* Make the menu_items vector twice as large. */ 248/* Call at the end of generating the data in menu_items.
249 This fills in the number of items in the last pane. */
102 250
103static void 251static void
104grow_menu_items (lpmm) 252finish_menu_items ()
105 menu_map * lpmm;
106{ 253{
107 Lisp_Object new;
108 int old_size = lpmm->menu_items_allocated;
109
110 lpmm->menu_items_allocated *= 2;
111 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
112 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
113 old_size * sizeof (Lisp_Object));
114
115 lpmm->menu_items = new;
116} 254}
117#endif
118 255
119/* Call when finished using the data for the current menu 256/* Call when finished using the data for the current menu
120 in menu_items. */ 257 in menu_items. */
121 258
122static void 259static void
123discard_menu_items (lpmm) 260discard_menu_items ()
124 menu_map * lpmm;
125{
126#if 0
127 lpmm->menu_items = Qnil;
128#endif
129 lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
130}
131
132/* Is this item a separator? */
133static int
134name_is_separator (name)
135 Lisp_Object name;
136{ 261{
137 int isseparator = (((char *)XSTRING (name)->data)[0] == 0); 262 /* Free the structure if it is especially large.
138 263 Otherwise, hold on to it, to save time. */
139 if (!isseparator) 264 if (menu_items_allocated > 200)
140 { 265 {
141 /* Check if name string consists of only dashes ('-') */ 266 menu_items = Qnil;
142 char *string = (char *)XSTRING (name)->data; 267 menu_items_allocated = 0;
143 while (*string == '-') string++;
144 isseparator = (*string == 0);
145 } 268 }
146
147 return isseparator;
148} 269}
149 270
271/* Make the menu_items vector twice as large. */
150 272
151/* Indicate boundary between left and right. */ 273static void
152 274grow_menu_items ()
153static void
154add_left_right_boundary (hmenu)
155 HMENU hmenu;
156{ 275{
157 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL); 276 Lisp_Object old;
277 int old_size = menu_items_allocated;
278 old = menu_items;
279
280 menu_items_allocated *= 2;
281 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
282 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
283 old_size * sizeof (Lisp_Object));
158} 284}
159 285
160/* Push one menu item into the current pane. 286/* Begin a submenu. */
161 NAME is the string to display. ENABLE if non-nil means
162 this item can be selected. KEY is the key generated by
163 choosing this item. EQUIV is the textual description
164 of the keyboard equivalent for this item (or nil if none). */
165
166static void
167add_menu_item (lpmm, hmenu, name, enable, key, equiv)
168 menu_map * lpmm;
169 HMENU hmenu;
170 Lisp_Object name;
171 UINT enable;
172 Lisp_Object key;
173 Lisp_Object equiv;
174{
175 UINT fuFlags;
176 Lisp_Object out_string;
177
178 if (NILP (name) || name_is_separator (name))
179 fuFlags = MF_SEPARATOR;
180 else
181 {
182 if (enable)
183 fuFlags = MF_STRING;
184 else
185 fuFlags = MF_STRING | MF_GRAYED;
186 287
187 if (!NILP (equiv)) 288static void
188 { 289push_submenu_start ()
189 out_string = concat2 (name, make_string ("\t", 1)); 290{
190 out_string = concat2 (out_string, equiv); 291 if (menu_items_used + 1 > menu_items_allocated)
191 } 292 grow_menu_items ();
192 else
193 out_string = name;
194 }
195 293
196 AppendMenu (hmenu, 294 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
197 fuFlags, 295 menu_items_submenu_depth++;
198 lpmm->menu_items_used + 1,
199 (fuFlags == MF_SEPARATOR)?NULL:
200 (char *) XSTRING (out_string)->data);
201
202 lpmm->menu_items_used++;
203#if 0
204 if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
205 grow_menu_items (lpmm);
206
207 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
208 Lisp_Cons,
209 key);
210#endif
211} 296}
212 297
213/* Figure out the current keyboard equivalent of a menu item ITEM1. 298/* End a submenu. */
214 The item string for menu display should be ITEM_STRING. 299
215 Store the equivalent keyboard key sequence's 300static void
216 textual description into *DESCRIP_PTR. 301push_submenu_end ()
217 Also cache them in the item itself.
218 Return the real definition to execute. */
219
220static Lisp_Object
221menu_item_equiv_key (item_string, item1, descrip_ptr)
222 Lisp_Object item_string;
223 Lisp_Object item1;
224 Lisp_Object *descrip_ptr;
225{ 302{
226 /* This is the real definition--the function to run. */ 303 if (menu_items_used + 1 > menu_items_allocated)
227 Lisp_Object def; 304 grow_menu_items ();
228 /* This is the sublist that records cached equiv key data
229 so we can save time. */
230 Lisp_Object cachelist;
231 /* These are the saved equivalent keyboard key sequence
232 and its key-description. */
233 Lisp_Object savedkey, descrip;
234 Lisp_Object def1;
235 int changed = 0;
236 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
237
238 /* If a help string follows the item string, skip it. */
239 if (CONSP (XCONS (item1)->cdr)
240 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
241 item1 = XCONS (item1)->cdr;
242
243 def = Fcdr (item1);
244
245 /* Get out the saved equivalent-keyboard-key info. */
246 cachelist = savedkey = descrip = Qnil;
247 if (CONSP (def) && CONSP (XCONS (def)->car)
248 && (NILP (XCONS (XCONS (def)->car)->car)
249 || VECTORP (XCONS (XCONS (def)->car)->car)))
250 {
251 cachelist = XCONS (def)->car;
252 def = XCONS (def)->cdr;
253 savedkey = XCONS (cachelist)->car;
254 descrip = XCONS (cachelist)->cdr;
255 }
256
257 GCPRO4 (def, def1, savedkey, descrip);
258
259 /* Is it still valid? */
260 def1 = Qnil;
261 if (!NILP (savedkey))
262 def1 = Fkey_binding (savedkey, Qnil);
263 /* If not, update it. */
264 if (! EQ (def1, def)
265 /* If the command is an alias for another
266 (such as easymenu.el and lmenu.el set it up),
267 check if the original command matches the cached command. */
268 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
269 && EQ (def1, XSYMBOL (def)->function))
270 /* If something had no key binding before, don't recheck it--
271 doing that takes too much time and makes menus too slow. */
272 && !(!NILP (cachelist) && NILP (savedkey)))
273 {
274 changed = 1;
275 descrip = Qnil;
276 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
277 /* If the command is an alias for another
278 (such as easymenu.el and lmenu.el set it up),
279 see if the original command name has equivalent keys. */
280 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
281 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
282 Qnil, Qt, Qnil);
283
284 if (VECTORP (savedkey)
285 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
286 savedkey = Qnil;
287 if (!NILP (savedkey))
288 {
289 descrip = Fkey_description (savedkey);
290 descrip = concat2 (make_string (" (", 3), descrip);
291 descrip = concat2 (descrip, make_string (")", 1));
292 }
293 }
294
295 /* Cache the data we just got in a sublist of the menu binding. */
296 if (NILP (cachelist))
297 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
298 else if (changed)
299 {
300 XCONS (cachelist)->car = savedkey;
301 XCONS (cachelist)->cdr = descrip;
302 }
303 305
304 UNGCPRO; 306 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
305 *descrip_ptr = descrip; 307 menu_items_submenu_depth--;
306 return def;
307} 308}
308 309
309/* This is used as the handler when calling internal_condition_case_1. */ 310/* Indicate boundary between left and right. */
310 311
311static Lisp_Object 312static void
312menu_item_enabled_p_1 (arg) 313push_left_right_boundary ()
313 Lisp_Object arg;
314{ 314{
315 return Qnil; 315 if (menu_items_used + 1 > menu_items_allocated)
316 grow_menu_items ();
317
318 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
316} 319}
317 320
318/* Return non-nil if the command DEF is enabled when used as a menu item. 321/* Start a new menu pane in menu_items..
319 This is based on looking for a menu-enable property. 322 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
320 If NOTREAL is set, don't bother really computing this. */
321 323
322static Lisp_Object 324static void
323menu_item_enabled_p (def, notreal) 325push_menu_pane (name, prefix_vec)
324 Lisp_Object def; 326 Lisp_Object name, prefix_vec;
325{ 327{
326 Lisp_Object enabled, tem; 328 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
329 grow_menu_items ();
330
331 if (menu_items_submenu_depth == 0)
332 menu_items_n_panes++;
333 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
334 XVECTOR (menu_items)->contents[menu_items_used++] = name;
335 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
336}
327 337
328 enabled = Qt; 338/* Push one menu item into the current pane.
329 if (notreal) 339 NAME is the string to display. ENABLE if non-nil means
330 return enabled; 340 this item can be selected. KEY is the key generated by
331 if (XTYPE (def) == Lisp_Symbol) 341 choosing this item, or nil if this item doesn't really have a definition.
332 { 342 DEF is the definition of this item.
333 /* No property, or nil, means enable. 343 EQUIV is the textual description of the keyboard equivalent for
334 Otherwise, enable if value is not nil. */ 344 this item (or nil if none). */
335 tem = Fget (def, Qmenu_enable); 345
336 if (!NILP (tem)) 346static void
337 /* (condition-case nil (eval tem) 347push_menu_item (name, enable, key, def, equiv)
338 (error nil)) */ 348 Lisp_Object name, enable, key, def, equiv;
339 enabled = internal_condition_case_1 (Feval, tem, Qerror, 349{
340 menu_item_enabled_p_1); 350 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
341 } 351 grow_menu_items ();
342 return enabled; 352
353 XVECTOR (menu_items)->contents[menu_items_used++] = name;
354 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
355 XVECTOR (menu_items)->contents[menu_items_used++] = key;
356 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
357 XVECTOR (menu_items)->contents[menu_items_used++] = def;
343} 358}
344 359
345/* Look through KEYMAPS, a vector of keymaps that is NMAPS long, 360/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
@@ -347,188 +362,69 @@ menu_item_enabled_p (def, notreal)
347 If NOTREAL is nonzero, 362 If NOTREAL is nonzero,
348 don't bother really computing whether an item is enabled. */ 363 don't bother really computing whether an item is enabled. */
349 364
350static HMENU 365static void
351keymap_panes (lpmm, keymaps, nmaps, notreal) 366keymap_panes (keymaps, nmaps, notreal)
352 menu_map * lpmm;
353 Lisp_Object *keymaps; 367 Lisp_Object *keymaps;
354 int nmaps; 368 int nmaps;
355 int notreal; 369 int notreal;
356{ 370{
357 int mapno; 371 int mapno;
358 372
359#if 0 373 init_menu_items ();
360 init_menu_items (lpmm);
361#endif
362 374
363 if (nmaps > 1) 375 /* Loop over the given keymaps, making a pane for each map.
364 { 376 But don't make a pane that is empty--ignore that map instead.
365 HMENU hmenu; 377 P is the number of panes we have made so far. */
366 378 for (mapno = 0; mapno < nmaps; mapno++)
367 if (!notreal) 379 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
368 {
369 hmenu = CreatePopupMenu ();
370
371 if (!hmenu) return (NULL);
372 }
373 else
374 {
375 hmenu = NULL;
376 }
377
378 /* Loop over the given keymaps, making a pane for each map.
379 But don't make a pane that is empty--ignore that map instead.
380 P is the number of panes we have made so far. */
381 for (mapno = 0; mapno < nmaps; mapno++)
382 {
383 HMENU new_hmenu;
384
385 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
386 Qnil, Qnil, notreal);
387
388 if (!notreal && new_hmenu)
389 {
390 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
391 }
392 }
393 380
394 return (hmenu); 381 finish_menu_items ();
395 }
396 else
397 {
398 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
399 }
400} 382}
401 383
402/* This is a recursive subroutine of keymap_panes. 384/* This is a recursive subroutine of keymap_panes.
403 It handles one keymap, KEYMAP. 385 It handles one keymap, KEYMAP.
404 The other arguments are passed along 386 The other arguments are passed along
405 or point to local variables of the previous function. 387 or point to local variables of the previous function.
406 If NOTREAL is nonzero, 388 If NOTREAL is nonzero, only check for equivalent key bindings, don't
407 don't bother really computing whether an item is enabled. */ 389 evaluate expressions in menu items and don't make any menu.
390
391 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
408 392
409HMENU 393static void
410single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) 394single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
411 menu_map * lpmm;
412 Lisp_Object keymap; 395 Lisp_Object keymap;
413 Lisp_Object pane_name; 396 Lisp_Object pane_name;
414 Lisp_Object prefix; 397 Lisp_Object prefix;
415 int notreal; 398 int notreal;
399 int maxdepth;
416{ 400{
417 Lisp_Object pending_maps; 401 Lisp_Object pending_maps = Qnil;
418 Lisp_Object tail, item, item1, item_string, table; 402 Lisp_Object tail, item;
419 HMENU hmenu; 403 struct gcpro gcpro1, gcpro2;
420 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 404 int notbuttons = 0;
421 405
422 if (!notreal) 406 if (maxdepth <= 0)
423 { 407 return;
424 hmenu = CreatePopupMenu (); 408
425 if (hmenu == NULL) return NULL; 409 push_menu_pane (pane_name, prefix);
426 } 410
427 else 411#ifndef HAVE_BOXES
428 { 412 /* Remember index for first item in this pane so we can go back and
429 hmenu = NULL; 413 add a prefix when (if) we see the first button. After that, notbuttons
430 } 414 is set to 0, to mark that we have seen a button and all non button
431 415 items need a prefix. */
432 pending_maps = Qnil; 416 notbuttons = menu_items_used;
433 417#endif
434 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) 418
419 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
435 { 420 {
436 /* Look at each key binding, and if it has a menu string, 421 GCPRO2 (keymap, pending_maps);
437 make a menu item from it. */ 422 /* Look at each key binding, and if it is a menu item add it
438 423 to this menu. */
439 item = XCONS (tail)->car; 424 item = XCONS (tail)->car;
440
441 if (CONSP (item)) 425 if (CONSP (item))
442 { 426 single_menu_item (XCONS (item)->car, XCONS (item)->cdr,
443 item1 = XCONS (item)->cdr; 427 &pending_maps, notreal, maxdepth, &notbuttons);
444
445 if (XTYPE (item1) == Lisp_Cons)
446 {
447 item_string = XCONS (item1)->car;
448 if (XTYPE (item_string) == Lisp_String)
449 {
450 /* This is the real definition--the function to run. */
451
452 Lisp_Object def;
453
454 /* These are the saved equivalent keyboard key sequence
455 and its key-description. */
456
457 Lisp_Object descrip;
458 Lisp_Object tem, enabled;
459
460 /* GCPRO because ...enabled_p will call eval
461 and ..._equiv_key may autoload something.
462 Protecting KEYMAP preserves everything we use;
463 aside from that, must protect whatever might be
464 a string. Since there's no GCPRO5, we refetch
465 item_string instead of protecting it. */
466
467 descrip = def = Qnil;
468 GCPRO4 (keymap, pending_maps, def, prefix);
469
470 def = menu_item_equiv_key (item_string, item1, &descrip);
471 {
472 struct gcpro gcpro1;
473 GCPRO1 (descrip);
474 enabled = menu_item_enabled_p (def, notreal);
475 UNGCPRO;
476 }
477
478 UNGCPRO;
479
480 item_string = XCONS (item1)->car;
481
482 tem = Fkeymapp (def);
483 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
484 {
485 pending_maps = Fcons (Fcons (def,
486 Fcons (item_string,
487 XCONS (item)->car)),
488 pending_maps);
489 }
490 else
491 {
492 Lisp_Object submap;
493
494 GCPRO5 (keymap, pending_maps, item, item_string, descrip);
495
496 submap = get_keymap_1 (def, 0, 1);
497
498 UNGCPRO;
499
500 if (NILP (submap))
501 {
502 if (!notreal)
503 {
504 add_menu_item (lpmm,
505 hmenu,
506 item_string,
507 !NILP (enabled),
508 Fcons (XCONS (item)->car, prefix),
509 descrip);
510 }
511 }
512 else
513 /* Display a submenu. */
514 {
515 HMENU new_hmenu = single_keymap_panes (lpmm,
516 submap,
517 item_string,
518 XCONS (item)->car,
519 notreal);
520
521 if (!notreal)
522 {
523 AppendMenu (hmenu, MF_POPUP,
524 (UINT)new_hmenu,
525 (char *) XSTRING (item_string)->data);
526 }
527 }
528 }
529 }
530 }
531 }
532 else if (VECTORP (item)) 428 else if (VECTORP (item))
533 { 429 {
534 /* Loop over the char values represented in the vector. */ 430 /* Loop over the char values represented in the vector. */
@@ -538,87 +434,11 @@ single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
538 { 434 {
539 Lisp_Object character; 435 Lisp_Object character;
540 XSETFASTINT (character, c); 436 XSETFASTINT (character, c);
541 item1 = XVECTOR (item)->contents[c]; 437 single_menu_item (character, XVECTOR (item)->contents[c],
542 if (CONSP (item1)) 438 &pending_maps, notreal, maxdepth, &notbuttons);
543 {
544 item_string = XCONS (item1)->car;
545 if (STRINGP (item_string))
546 {
547 Lisp_Object def;
548
549 /* These are the saved equivalent keyboard key sequence
550 and its key-description. */
551 Lisp_Object descrip;
552 Lisp_Object tem, enabled;
553
554 /* GCPRO because ...enabled_p will call eval
555 and ..._equiv_key may autoload something.
556 Protecting KEYMAP preserves everything we use;
557 aside from that, must protect whatever might be
558 a string. Since there's no GCPRO5, we refetch
559 item_string instead of protecting it. */
560 GCPRO3 (keymap, pending_maps, def);
561 descrip = def = Qnil;
562
563 def = menu_item_equiv_key (item_string, item1, &descrip);
564 {
565 struct gcpro gcpro1;
566 GCPRO1 (descrip);
567 enabled = menu_item_enabled_p (def, notreal);
568 UNGCPRO;
569 }
570
571 UNGCPRO;
572
573 item_string = XCONS (item1)->car;
574
575 tem = Fkeymapp (def);
576 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
577 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
578 pending_maps);
579 else
580 {
581 Lisp_Object submap;
582
583 GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
584
585 submap = get_keymap_1 (def, 0, 1);
586
587 UNGCPRO;
588
589 if (NILP (submap))
590 {
591 if (!notreal)
592 {
593 add_menu_item (lpmm,
594 hmenu,
595 item_string,
596 !NILP (enabled),
597 character,
598 descrip);
599 }
600 }
601 else
602 /* Display a submenu. */
603 {
604 HMENU new_hmenu = single_keymap_panes (lpmm,
605 submap,
606 Qnil,
607 character,
608 notreal);
609
610 if (!notreal)
611 {
612 AppendMenu (hmenu,MF_POPUP,
613 (UINT)new_hmenu,
614 (char *)XSTRING (item_string)->data);
615 }
616 }
617 }
618 }
619 }
620 } 439 }
621 } 440 }
441 UNGCPRO;
622 } 442 }
623 443
624 /* Process now any submenus which want to be panes at this level. */ 444 /* Process now any submenus which want to be panes at this level. */
@@ -629,557 +449,205 @@ single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
629 eltcdr = XCONS (elt)->cdr; 449 eltcdr = XCONS (elt)->cdr;
630 string = XCONS (eltcdr)->car; 450 string = XCONS (eltcdr)->car;
631 /* We no longer discard the @ from the beginning of the string here. 451 /* We no longer discard the @ from the beginning of the string here.
632 Instead, we do this in w32menu_show. */ 452 Instead, we do this in w32_menu_show. */
633 { 453 single_keymap_panes (Fcar (elt), string,
634 HMENU new_hmenu = single_keymap_panes (lpmm, 454 XCONS (eltcdr)->cdr, notreal, maxdepth - 1);
635 Fcar (elt),
636 string,
637 XCONS (eltcdr)->cdr, notreal);
638
639 if (!notreal)
640 {
641 AppendMenu (hmenu, MF_POPUP,
642 (UINT)new_hmenu,
643 (char *) XSTRING (string)->data);
644 }
645 }
646
647 pending_maps = Fcdr (pending_maps); 455 pending_maps = Fcdr (pending_maps);
648 } 456 }
649
650 return (hmenu);
651} 457}
652 458
653/* Push all the panes and items of a menu described by the 459/* This is a subroutine of single_keymap_panes that handles one
654 alist-of-alists MENU. 460 keymap entry.
655 This handles old-fashioned calls to x-popup-menu. */ 461 KEY is a key in a keymap and ITEM is its binding.
656 462 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
657static HMENU 463 separate panes.
658list_of_panes (lpmm, menu) 464 If NOTREAL is nonzero, only check for equivalent key bindings, don't
659 menu_map * lpmm; 465 evaluate expressions in menu items and don't make any menu.
660 Lisp_Object menu; 466 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
467 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
468 buttons. It points to variable notbuttons in single_keymap_panes,
469 which keeps track of if we have seen a button in this menu or not. */
470
471static void
472single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
473 notbuttons_ptr)
474 Lisp_Object key, item;
475 Lisp_Object *pending_maps_ptr;
476 int maxdepth, notreal;
477 int *notbuttons_ptr;
661{ 478{
662 Lisp_Object tail; 479 Lisp_Object def, map, item_string, enabled;
663 HMENU hmenu; 480 struct gcpro gcpro1, gcpro2;
664 481 int res;
665 if (XFASTINT (Flength (menu)) > 1)
666 {
667 hmenu = CreatePopupMenu ();
668 if (hmenu == NULL) return NULL;
669 482
670/* init_menu_items (lpmm); */ 483 /* Parse the menu item and leave the result in item_properties. */
671 484 GCPRO2 (key, item);
672 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) 485 res = parse_menu_item (item, notreal, 0);
673 { 486 UNGCPRO;
674 Lisp_Object elt, pane_name, pane_data; 487 if (!res)
675 HMENU new_hmenu; 488 return; /* Not a menu item. */
676
677 elt = Fcar (tail);
678 pane_name = Fcar (elt);
679 CHECK_STRING (pane_name, 0);
680 pane_data = Fcdr (elt);
681 CHECK_CONS (pane_data, 0);
682
683 if (XSTRING (pane_name)->data[0] == 0)
684 {
685 list_of_items (hmenu, lpmm, pane_data);
686 }
687 else
688 {
689 new_hmenu = list_of_items (NULL, lpmm, pane_data);
690 if (new_hmenu == NULL) goto error;
691 489
692 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, 490 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
693 (char *) XSTRING (pane_name)->data);
694 }
695 }
696 }
697 else
698 {
699 Lisp_Object elt, pane_name, pane_data;
700
701 elt = Fcar (menu);
702 pane_name = Fcar (elt);
703 CHECK_STRING (pane_name, 0);
704 pane_data = Fcdr (elt);
705 CHECK_CONS (pane_data, 0);
706 hmenu = list_of_items (NULL, lpmm, pane_data);
707 }
708 return (hmenu);
709
710 error:
711 DestroyMenu (hmenu);
712 491
713 return (NULL); 492 if (notreal)
714}
715
716/* Push the items in a single pane defined by the alist PANE. */
717
718static HMENU
719list_of_items (hmenu, lpmm, pane)
720 HMENU hmenu;
721 menu_map * lpmm;
722 Lisp_Object pane;
723{
724 Lisp_Object tail, item, item1;
725
726 if (hmenu == NULL)
727 {
728 hmenu = CreatePopupMenu ();
729 if (hmenu == NULL) return NULL;
730 }
731
732 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
733 { 493 {
734 item = Fcar (tail); 494 /* We don't want to make a menu, just traverse the keymaps to
735 if (STRINGP (item)) 495 precompute equivalent key bindings. */
736 add_menu_item (lpmm, hmenu, item, 0, Qnil, Qnil); 496 if (!NILP (map))
737 else if (NILP (item)) 497 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
738 add_left_right_boundary (); 498 return;
739 else
740 {
741 CHECK_CONS (item, 0);
742 item1 = Fcar (item);
743 CHECK_STRING (item1, 1);
744 add_menu_item (lpmm, hmenu, item1, 1, Fcdr (item), Qnil);
745 }
746 } 499 }
747 500
748 return (hmenu); 501 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
749} 502 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
750
751
752HMENU
753create_menu_items (lpmm, menu, notreal)
754 menu_map * lpmm;
755 Lisp_Object menu;
756 int notreal;
757{
758 Lisp_Object title;
759 Lisp_Object keymap, tem;
760 HMENU hmenu;
761
762 title = Qnil;
763
764 /* Decode the menu items from what was specified. */
765
766 keymap = Fkeymapp (menu);
767 tem = Qnil;
768 if (XTYPE (menu) == Lisp_Cons)
769 tem = Fkeymapp (Fcar (menu));
770
771 if (!NILP (keymap))
772 {
773 /* We were given a keymap. Extract menu info from the keymap. */
774 Lisp_Object prompt;
775 keymap = get_keymap (menu);
776
777 /* Extract the detailed info to make one pane. */
778 hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
779
780#if 0
781 /* Search for a string appearing directly as an element of the keymap.
782 That string is the title of the menu. */
783 prompt = map_prompt (keymap);
784 503
785 /* Make that be the pane title of the first pane. */ 504 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
786 if (!NILP (prompt) && menu_items_n_panes >= 0)
787 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
788#endif
789 }
790 else if (!NILP (tem))
791 {
792 /* We were given a list of keymaps. */
793 int nmaps = XFASTINT (Flength (menu));
794 Lisp_Object *maps
795 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
796 int i;
797
798 title = Qnil;
799
800 /* The first keymap that has a prompt string
801 supplies the menu title. */
802 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
803 {
804 Lisp_Object prompt;
805
806 maps[i++] = keymap = get_keymap (Fcar (tem));
807#if 0
808 prompt = map_prompt (keymap);
809 if (NILP (title) && !NILP (prompt))
810 title = prompt;
811#endif
812 }
813
814 /* Extract the detailed info to make one pane. */
815 hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
816
817#if 0
818 /* Make the title be the pane title of the first pane. */
819 if (!NILP (title) && menu_items_n_panes >= 0)
820 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
821#endif
822 }
823 else
824 { 505 {
825 /* We were given an old-fashioned menu. */ 506 if (!NILP (enabled))
826 title = Fcar (menu); 507 /* An enabled separate pane. Remember this to handle it later. */
827 CHECK_STRING (title, 1); 508 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
828 509 *pending_maps_ptr);
829 hmenu = list_of_panes (lpmm, Fcdr (menu)); 510 return;
830 } 511 }
831
832 return (hmenu);
833}
834 512
835/* This is a recursive subroutine of keymap_panes. 513#ifndef HAVE_BOXES
836 It handles one keymap, KEYMAP. 514 /* Simulate radio buttons and toggle boxes by putting a prefix in
837 The other arguments are passed along 515 front of them. */
838 or point to local variables of the previous function. 516 {
839 If NOTREAL is nonzero, 517 Lisp_Object prefix = Qnil;
840 don't bother really computing whether an item is enabled. */ 518 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
841 519 if (!NILP (type))
842Lisp_Object
843get_single_keymap_event (keymap, lpnum)
844 Lisp_Object keymap;
845 int * lpnum;
846{
847 Lisp_Object pending_maps;
848 Lisp_Object tail, item, item1, item_string, table;
849 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
850
851 pending_maps = Qnil;
852
853 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
854 {
855 /* Look at each key binding, and if it has a menu string,
856 make a menu item from it. */
857
858 item = XCONS (tail)->car;
859
860 if (XTYPE (item) == Lisp_Cons)
861 {
862 item1 = XCONS (item)->cdr;
863
864 if (CONSP (item1))
865 {
866 item_string = XCONS (item1)->car;
867 if (XTYPE (item_string) == Lisp_String)
868 {
869 /* This is the real definition--the function to run. */
870
871 Lisp_Object def;
872
873 /* These are the saved equivalent keyboard key sequence
874 and its key-description. */
875
876 Lisp_Object descrip;
877 Lisp_Object tem, enabled;
878
879 /* GCPRO because ...enabled_p will call eval
880 and ..._equiv_key may autoload something.
881 Protecting KEYMAP preserves everything we use;
882 aside from that, must protect whatever might be
883 a string. Since there's no GCPRO5, we refetch
884 item_string instead of protecting it. */
885
886 descrip = def = Qnil;
887 GCPRO3 (keymap, pending_maps, def);
888
889 def = menu_item_equiv_key (item_string, item1, &descrip);
890
891 UNGCPRO;
892
893 item_string = XCONS (item1)->car;
894
895 tem = Fkeymapp (def);
896 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
897 {
898 pending_maps = Fcons (Fcons (def,
899 Fcons (item_string,
900 XCONS (item)->car)),
901 pending_maps);
902 }
903 else
904 {
905 Lisp_Object submap;
906
907 GCPRO5 (keymap, pending_maps, item, item_string, descrip);
908
909 submap = get_keymap_1 (def, 0, 1);
910
911 UNGCPRO;
912
913 if (NILP (submap))
914 {
915 if (--(*lpnum) == 0)
916 {
917 return (Fcons (XCONS (item)->car, Qnil));
918 }
919 }
920 else
921 /* Display a submenu. */
922 {
923 Lisp_Object event = get_single_keymap_event (submap,
924 lpnum);
925
926 if (*lpnum <= 0)
927 {
928 if (!NILP (XCONS (item)->car))
929 event = Fcons (XCONS (item)->car, event);
930
931 return (event);
932 }
933 }
934 }
935 }
936 }
937 }
938 else if (VECTORP (item))
939 {
940 /* Loop over the char values represented in the vector. */
941 int len = XVECTOR (item)->size;
942 int c;
943 for (c = 0; c < len; c++)
944 {
945 Lisp_Object character;
946 XSETFASTINT (character, c);
947 item1 = XVECTOR (item)->contents[c];
948 if (XTYPE (item1) == Lisp_Cons)
949 {
950 item_string = XCONS (item1)->car;
951 if (XTYPE (item_string) == Lisp_String)
952 {
953 Lisp_Object def;
954
955 /* These are the saved equivalent keyboard key sequence
956 and its key-description. */
957 Lisp_Object descrip;
958 Lisp_Object tem, enabled;
959
960 /* GCPRO because ...enabled_p will call eval
961 and ..._equiv_key may autoload something.
962 Protecting KEYMAP preserves everything we use;
963 aside from that, must protect whatever might be
964 a string. Since there's no GCPRO5, we refetch
965 item_string instead of protecting it. */
966 GCPRO3 (keymap, pending_maps, def);
967 descrip = def = Qnil;
968
969 def = menu_item_equiv_key (item_string, item1, &descrip);
970
971 UNGCPRO;
972
973 item_string = XCONS (item1)->car;
974
975 tem = Fkeymapp (def);
976 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
977 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
978 pending_maps);
979 else
980 {
981 Lisp_Object submap;
982
983 GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
984
985 submap = get_keymap_1 (def, 0, 1);
986
987 UNGCPRO;
988
989 if (NILP (submap))
990 {
991 if (--(*lpnum) == 0)
992 {
993 return (Fcons (character, Qnil));
994 }
995 }
996 else
997 /* Display a submenu. */
998 {
999 Lisp_Object event = get_single_keymap_event (submap,
1000 lpnum);
1001
1002 if (*lpnum <= 0)
1003 {
1004 if (!NILP (character))
1005 event = Fcons (character, event);
1006
1007 return (event);
1008 }
1009 }
1010 }
1011 }
1012 }
1013 }
1014 }
1015 }
1016
1017 /* Process now any submenus which want to be panes at this level. */
1018 while (!NILP (pending_maps))
1019 {
1020 Lisp_Object elt, eltcdr, string;
1021 elt = Fcar (pending_maps);
1022 eltcdr = XCONS (elt)->cdr;
1023 string = XCONS (eltcdr)->car;
1024 /* We no longer discard the @ from the beginning of the string here.
1025 Instead, we do this in w32menu_show. */
1026 { 520 {
1027 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum); 521 Lisp_Object selected
522 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
1028 523
1029 if (*lpnum <= 0) 524 if (*notbuttons_ptr)
525 /* The first button. Line up previous items in this menu. */
1030 { 526 {
1031 if (!NILP (XCONS (eltcdr)->cdr)) 527 int index = *notbuttons_ptr; /* Index for first item this menu. */
1032 event = Fcons (XCONS (eltcdr)->cdr, event); 528 int submenu = 0;
1033 529 Lisp_Object tem;
1034 return (event); 530 while (index < menu_items_used)
531 {
532 tem
533 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
534 if (NILP (tem))
535 {
536 index++;
537 submenu++; /* Skip sub menu. */
538 }
539 else if (EQ (tem, Qlambda))
540 {
541 index++;
542 submenu--; /* End sub menu. */
543 }
544 else if (EQ (tem, Qt))
545 index += 3; /* Skip new pane marker. */
546 else if (EQ (tem, Qquote))
547 index++; /* Skip a left, right divider. */
548 else
549 {
550 if (!submenu && XSTRING (tem)->data[0] != '\0'
551 && XSTRING (tem)->data[0] != '-')
552 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
553 = concat2 (build_string (" "), tem);
554 index += MENU_ITEMS_ITEM_LENGTH;
555 }
556 }
557 *notbuttons_ptr = 0;
1035 } 558 }
559
560 /* Calculate prefix, if any, for this item. */
561 if (EQ (type, QCtoggle))
562 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
563 else if (EQ (type, QCradio))
564 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
1036 } 565 }
566 /* Not a button. If we have earlier buttons, then we need a prefix. */
567 else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
568 && XSTRING (item_string)->data[0] != '-')
569 prefix = build_string (" ");
1037 570
1038 pending_maps = Fcdr (pending_maps); 571 if (!NILP (prefix))
1039 } 572 item_string = concat2 (prefix, item_string);
1040 573 }
1041 return (Qnil); 574#endif /* not HAVE_BOXES */
1042} 575
576#if 0
577 if (!NILP(map))
578 /* Indicate visually that this is a submenu. */
579 item_string = concat2 (item_string, build_string (" >"));
580#endif
1043 581
1044/* Look through KEYMAPS, a vector of keymaps that is NMAPS long, 582 push_menu_item (item_string, enabled, key,
1045 and generate menu panes for them in menu_items. 583 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
1046 If NOTREAL is nonzero, 584 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
1047 don't bother really computing whether an item is enabled. */
1048 585
1049static Lisp_Object 586#if 1
1050get_keymap_event (keymaps, nmaps, lpnum) 587 /* Display a submenu using the toolkit. */
1051 Lisp_Object *keymaps; 588 if (! (NILP (map) || NILP (enabled)))
1052 int nmaps;
1053 int * lpnum;
1054{
1055 int mapno;
1056 Lisp_Object event = Qnil;
1057
1058 /* Loop over the given keymaps, making a pane for each map.
1059 But don't make a pane that is empty--ignore that map instead.
1060 P is the number of panes we have made so far. */
1061 for (mapno = 0; mapno < nmaps; mapno++)
1062 { 589 {
1063 event = get_single_keymap_event (keymaps[mapno], lpnum); 590 push_submenu_start ();
1064 591 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
1065 if (*lpnum <= 0) break; 592 push_submenu_end ();
1066 } 593 }
1067 594#endif
1068 return (event);
1069}
1070
1071static Lisp_Object
1072get_list_of_items_event (pane, lpnum)
1073 Lisp_Object pane;
1074 int * lpnum;
1075{
1076 Lisp_Object tail, item, item1;
1077
1078 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
1079 {
1080 item = Fcar (tail);
1081 if (STRINGP (item))
1082 {
1083 if (-- (*lpnum) == 0)
1084 {
1085 return (Qnil);
1086 }
1087 }
1088 else if (!NILP (item))
1089 {
1090 if (--(*lpnum) == 0)
1091 {
1092 CHECK_CONS (item, 0);
1093 return (Fcdr (item));
1094 }
1095 }
1096 }
1097
1098 return (Qnil);
1099} 595}
1100 596
1101/* Push all the panes and items of a menu described by the 597/* Push all the panes and items of a menu described by the
1102 alist-of-alists MENU. 598 alist-of-alists MENU.
1103 This handles old-fashioned calls to x-popup-menu. */ 599 This handles old-fashioned calls to x-popup-menu. */
1104 600
1105static Lisp_Object 601static void
1106get_list_of_panes_event (menu, lpnum) 602list_of_panes (menu)
1107 Lisp_Object menu; 603 Lisp_Object menu;
1108 int * lpnum;
1109{ 604{
1110 Lisp_Object tail; 605 Lisp_Object tail;
1111 606
607 init_menu_items ();
608
1112 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) 609 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1113 { 610 {
1114 Lisp_Object elt, pane_name, pane_data; 611 Lisp_Object elt, pane_name, pane_data;
1115 Lisp_Object event;
1116
1117 elt = Fcar (tail); 612 elt = Fcar (tail);
613 pane_name = Fcar (elt);
614 CHECK_STRING (pane_name, 0);
615 push_menu_pane (pane_name, Qnil);
1118 pane_data = Fcdr (elt); 616 pane_data = Fcdr (elt);
1119 CHECK_CONS (pane_data, 0); 617 CHECK_CONS (pane_data, 0);
1120 618 list_of_items (pane_data);
1121 event = get_list_of_items_event (pane_data, lpnum);
1122
1123 if (*lpnum <= 0)
1124 {
1125 return (event);
1126 }
1127 } 619 }
1128 620
1129 return (Qnil); 621 finish_menu_items ();
1130} 622}
1131 623
1132Lisp_Object 624/* Push the items in a single pane defined by the alist PANE. */
1133get_menu_event (menu, lpnum) 625
1134 Lisp_Object menu; 626static void
1135 int * lpnum; 627list_of_items (pane)
628 Lisp_Object pane;
1136{ 629{
1137 Lisp_Object keymap, tem; 630 Lisp_Object tail, item, item1;
1138 Lisp_Object event;
1139
1140 /* Decode the menu items from what was specified. */
1141
1142 keymap = Fkeymapp (menu);
1143 tem = Qnil;
1144 if (XTYPE (menu) == Lisp_Cons)
1145 tem = Fkeymapp (Fcar (menu));
1146 631
1147 if (!NILP (keymap)) 632 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
1148 {
1149 keymap = get_keymap (menu);
1150
1151 event = get_keymap_event (&keymap, 1, lpnum);
1152 }
1153 else if (!NILP (tem))
1154 { 633 {
1155 /* We were given a list of keymaps. */ 634 item = Fcar (tail);
1156 int nmaps = XFASTINT (Flength (menu)); 635 if (STRINGP (item))
1157 Lisp_Object *maps 636 push_menu_item (item, Qnil, Qnil, Qt, Qnil);
1158 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); 637 else if (NILP (item))
1159 int i; 638 push_left_right_boundary ();
1160 639 else
1161 /* The first keymap that has a prompt string
1162 supplies the menu title. */
1163 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1164 { 640 {
1165 Lisp_Object prompt; 641 CHECK_CONS (item, 0);
1166 642 item1 = Fcar (item);
1167 maps[i++] = keymap = get_keymap (Fcar (tem)); 643 CHECK_STRING (item1, 1);
644 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil);
1168 } 645 }
1169
1170 event = get_keymap_event (maps, nmaps, lpnum);
1171 }
1172 else
1173 {
1174 /* We were given an old-fashioned menu. */
1175 event = get_list_of_panes_event (Fcdr (menu), lpnum);
1176 } 646 }
1177
1178 return (event);
1179} 647}
1180 648
1181DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, 649DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1182 "Pop up a deck-of-cards menu and return user's selection.\n\ 650 "Pop up a deck-of-cards menu and return user's selection.\n\
1183POSITION is a position specification. This is either a mouse button event\n\ 651POSITION is a position specification. This is either a mouse button event\n\
1184or a list ((XOFFSET YOFFSET) WINDOW)\n\ 652or a list ((XOFFSET YOFFSET) WINDOW)\n\
1185where XOFFSET and YOFFSET are positions in pixels from the top left\n\ 653where XOFFSET and YOFFSET are positions in pixels from the top left\n\
@@ -1193,10 +661,14 @@ The menu items come from key bindings that have a menu string as well as\n\
1193a definition; actually, the \"definition\" in such a key binding looks like\n\ 661a definition; actually, the \"definition\" in such a key binding looks like\n\
1194\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ 662\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1195the keymap as a top-level element.\n\n\ 663the keymap as a top-level element.\n\n\
664If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
665Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
666\n\
1196You can also use a list of keymaps as MENU.\n\ 667You can also use a list of keymaps as MENU.\n\
1197 Then each keymap makes a separate pane.\n\ 668 Then each keymap makes a separate pane.\n\
1198When MENU is a keymap or a list of keymaps, the return value\n\ 669When MENU is a keymap or a list of keymaps, the return value\n\
1199is a list of events.\n\n\ 670is a list of events.\n\n\
671\n\
1200Alternatively, you can specify a menu of multiple panes\n\ 672Alternatively, you can specify a menu of multiple panes\n\
1201 with a list of the form (TITLE PANE1 PANE2...),\n\ 673 with a list of the form (TITLE PANE1 PANE2...),\n\
1202where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ 674where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
@@ -1207,8 +679,8 @@ With this form of menu, the return value is VALUE from the chosen item.\n\
1207\n\ 679\n\
1208If POSITION is nil, don't display the menu at all, just precalculate the\n\ 680If POSITION is nil, don't display the menu at all, just precalculate the\n\
1209cached information about equivalent key sequences.") 681cached information about equivalent key sequences.")
1210 (position, menu) 682 (position, menu)
1211 Lisp_Object position, menu; 683 Lisp_Object position, menu;
1212{ 684{
1213 int number_of_panes, panes; 685 int number_of_panes, panes;
1214 Lisp_Object keymap, tem; 686 Lisp_Object keymap, tem;
@@ -1220,13 +692,14 @@ cached information about equivalent key sequences.")
1220 FRAME_PTR f; 692 FRAME_PTR f;
1221 Lisp_Object x, y, window; 693 Lisp_Object x, y, window;
1222 int keymaps = 0; 694 int keymaps = 0;
1223 int menubarp = 0; 695 int for_click = 0;
1224 struct gcpro gcpro1; 696 struct gcpro gcpro1;
1225 HMENU hmenu; 697
1226 menu_map mm; 698#ifdef HAVE_MENUS
1227
1228 if (! NILP (position)) 699 if (! NILP (position))
1229 { 700 {
701 check_w32 ();
702
1230 /* Decode the first argument: find the window and the coordinates. */ 703 /* Decode the first argument: find the window and the coordinates. */
1231 if (EQ (position, Qt) 704 if (EQ (position, Qt)
1232 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar))) 705 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
@@ -1236,10 +709,10 @@ cached information about equivalent key sequences.")
1236 Lisp_Object bar_window; 709 Lisp_Object bar_window;
1237 int part; 710 int part;
1238 unsigned long time; 711 unsigned long time;
1239 712
1240 if (mouse_position_hook) 713 if (mouse_position_hook)
1241 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, 714 (*mouse_position_hook) (&new_f, 1, &bar_window,
1242 &time); 715 &part, &x, &y, &time);
1243 if (new_f != 0) 716 if (new_f != 0)
1244 XSETFRAME (window, new_f); 717 XSETFRAME (window, new_f);
1245 else 718 else
@@ -1260,28 +733,23 @@ cached information about equivalent key sequences.")
1260 } 733 }
1261 else 734 else
1262 { 735 {
1263 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ 736 for_click = 1;
1264 window = Fcar (tem); /* POSN_WINDOW (tem) */ 737 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
738 window = Fcar (tem); /* POSN_WINDOW (tem) */
1265 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ 739 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1266 x = Fcar (tem); 740 x = Fcar (tem);
1267 y = Fcdr (tem); 741 y = Fcdr (tem);
1268
1269 /* Determine whether this menu is handling a menu bar click. */
1270 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1271 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1272 menubarp = 1;
1273 } 742 }
1274 } 743 }
1275 744
1276 CHECK_NUMBER (x, 0); 745 CHECK_NUMBER (x, 0);
1277 CHECK_NUMBER (y, 0); 746 CHECK_NUMBER (y, 0);
1278 747
1279 /* Decode where to put the menu. */ 748 /* Decode where to put the menu. */
1280 749
1281 if (FRAMEP (window)) 750 if (FRAMEP (window))
1282 { 751 {
1283 f = XFRAME (window); 752 f = XFRAME (window);
1284
1285 xpos = 0; 753 xpos = 0;
1286 ypos = 0; 754 ypos = 0;
1287 } 755 }
@@ -1289,53 +757,126 @@ cached information about equivalent key sequences.")
1289 { 757 {
1290 CHECK_LIVE_WINDOW (window, 0); 758 CHECK_LIVE_WINDOW (window, 0);
1291 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); 759 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1292 760
1293 xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left); 761 xpos = (FONT_WIDTH (f->output_data.w32->font)
1294 ypos = (f->output_data.w32->line_height * XWINDOW (window)->top); 762 * XFASTINT (XWINDOW (window)->left));
763 ypos = (f->output_data.w32->line_height
764 * XFASTINT (XWINDOW (window)->top));
1295 } 765 }
1296 else 766 else
1297 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, 767 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1298 but I don't want to make one now. */ 768 but I don't want to make one now. */
1299 CHECK_WINDOW (window, 0); 769 CHECK_WINDOW (window, 0);
1300 770
1301 xpos += XINT (x); 771 xpos += XINT (x);
1302 ypos += XINT (y); 772 ypos += XINT (y);
1303 773
1304 XSETFRAME (Vmenu_updating_frame, f); 774 XSETFRAME (Vmenu_updating_frame, f);
1305 } 775 }
1306 Vmenu_updating_frame = Qnil; 776 Vmenu_updating_frame = Qnil;
777#endif /* HAVE_MENUS */
1307 778
1308 title = Qnil; 779 title = Qnil;
1309 GCPRO1 (title); 780 GCPRO1 (title);
1310 781
1311 discard_menu_items (&mm); 782 /* Decode the menu items from what was specified. */
1312 hmenu = create_menu_items (&mm, menu, NILP (position)); 783
784 keymap = Fkeymapp (menu);
785 tem = Qnil;
786 if (CONSP (menu))
787 tem = Fkeymapp (Fcar (menu));
788 if (!NILP (keymap))
789 {
790 /* We were given a keymap. Extract menu info from the keymap. */
791 Lisp_Object prompt;
792 keymap = get_keymap (menu);
793
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (&menu, 1, NILP (position));
796
797 /* Search for a string appearing directly as an element of the keymap.
798 That string is the title of the menu. */
799 prompt = map_prompt (keymap);
800 if (NILP (title) && !NILP (prompt))
801 title = prompt;
802
803 /* Make that be the pane title of the first pane. */
804 if (!NILP (prompt) && menu_items_n_panes >= 0)
805 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
806
807 keymaps = 1;
808 }
809 else if (!NILP (tem))
810 {
811 /* We were given a list of keymaps. */
812 int nmaps = XFASTINT (Flength (menu));
813 Lisp_Object *maps
814 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
815 int i;
816
817 title = Qnil;
818
819 /* The first keymap that has a prompt string
820 supplies the menu title. */
821 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
822 {
823 Lisp_Object prompt;
824
825 maps[i++] = keymap = get_keymap (Fcar (tem));
826
827 prompt = map_prompt (keymap);
828 if (NILP (title) && !NILP (prompt))
829 title = prompt;
830 }
831
832 /* Extract the detailed info to make one pane. */
833 keymap_panes (maps, nmaps, NILP (position));
834
835 /* Make the title be the pane title of the first pane. */
836 if (!NILP (title) && menu_items_n_panes >= 0)
837 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
838
839 keymaps = 1;
840 }
841 else
842 {
843 /* We were given an old-fashioned menu. */
844 title = Fcar (menu);
845 CHECK_STRING (title, 1);
846
847 list_of_panes (Fcdr (menu));
848
849 keymaps = 0;
850 }
1313 851
1314 if (NILP (position)) 852 if (NILP (position))
1315 { 853 {
1316 discard_menu_items (&mm); 854 discard_menu_items ();
1317 UNGCPRO; 855 UNGCPRO;
1318 return Qnil; 856 return Qnil;
1319 } 857 }
1320 858
859#ifdef HAVE_MENUS
1321 /* Display them in a menu. */ 860 /* Display them in a menu. */
1322 BLOCK_INPUT; 861 BLOCK_INPUT;
1323 862
1324 selection = w32menu_show (f, xpos, ypos, menu, hmenu, &error_name); 863 selection = w32_menu_show (f, xpos, ypos, for_click,
1325 864 keymaps, title, &error_name);
1326 UNBLOCK_INPUT; 865 UNBLOCK_INPUT;
1327 866
1328 discard_menu_items (&mm); 867 discard_menu_items ();
1329 DestroyMenu (hmenu); 868
1330
1331 UNGCPRO; 869 UNGCPRO;
1332 870#endif /* HAVE_MENUS */
871
1333 if (error_name) error (error_name); 872 if (error_name) error (error_name);
1334 return selection; 873 return selection;
1335} 874}
1336 875
876#ifdef HAVE_MENUS
877
1337DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, 878DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1338 "Pop up a dialog box and return user's selection.\n\ 879 "Pop up a dialog box and return user's selection.\n\
1339POSITION specifies which frame to use.\n\ 880POSITION specifies which frame to use.\n\
1340This is normally a mouse button event or a window or frame.\n\ 881This is normally a mouse button event or a window or frame.\n\
1341If POSITION is t, it means to use the frame the mouse is on.\n\ 882If POSITION is t, it means to use the frame the mouse is on.\n\
@@ -1349,36 +890,54 @@ An ITEM may also be just a string--that makes a nonselectable item.\n\
1349An ITEM may also be nil--that means to put all preceding items\n\ 890An ITEM may also be nil--that means to put all preceding items\n\
1350on the left of the dialog box and all following items on the right.\n\ 891on the left of the dialog box and all following items on the right.\n\
1351\(By default, approximately half appear on each side.)") 892\(By default, approximately half appear on each side.)")
1352 (position, contents) 893 (position, contents)
1353 Lisp_Object position, contents; 894 Lisp_Object position, contents;
1354{ 895{
1355 FRAME_PTR f; 896 FRAME_PTR f;
1356 Lisp_Object window; 897 Lisp_Object window;
1357 898
899 check_w32 ();
900
1358 /* Decode the first argument: find the window or frame to use. */ 901 /* Decode the first argument: find the window or frame to use. */
1359 if (EQ (position, Qt)) 902 if (EQ (position, Qt)
903 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
1360 { 904 {
1361 /* Decode the first argument: find the window and the coordinates. */ 905#if 0 /* Using the frame the mouse is on may not be right. */
1362 if (EQ (position, Qt)) 906 /* Use the mouse's current position. */
907 FRAME_PTR new_f = selected_frame;
908 Lisp_Object bar_window;
909 int part;
910 unsigned long time;
911 Lisp_Object x, y;
912
913 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
914
915 if (new_f != 0)
916 XSETFRAME (window, new_f);
917 else
1363 window = selected_window; 918 window = selected_window;
919#endif
920 window = selected_window;
1364 } 921 }
1365 else if (CONSP (position)) 922 else if (CONSP (position))
1366 { 923 {
1367 Lisp_Object tem; 924 Lisp_Object tem;
1368 tem = Fcar (position); 925 tem = Fcar (position);
1369 if (XTYPE (tem) == Lisp_Cons) 926 if (CONSP (tem))
1370 window = Fcar (Fcdr (position)); 927 window = Fcar (Fcdr (position));
1371 else 928 else
1372 { 929 {
1373 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ 930 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1374 window = Fcar (tem); /* POSN_WINDOW (tem) */ 931 window = Fcar (tem); /* POSN_WINDOW (tem) */
1375 } 932 }
1376 } 933 }
1377 else if (WINDOWP (position) || FRAMEP (position)) 934 else if (WINDOWP (position) || FRAMEP (position))
1378 window = position; 935 window = position;
1379 936 else
937 window = Qnil;
938
1380 /* Decode where to put the menu. */ 939 /* Decode where to put the menu. */
1381 940
1382 if (FRAMEP (window)) 941 if (FRAMEP (window))
1383 f = XFRAME (window); 942 f = XFRAME (window);
1384 else if (WINDOWP (window)) 943 else if (WINDOWP (window))
@@ -1390,7 +949,7 @@ on the left of the dialog box and all following items on the right.\n\
1390 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, 949 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1391 but I don't want to make one now. */ 950 but I don't want to make one now. */
1392 CHECK_WINDOW (window, 0); 951 CHECK_WINDOW (window, 0);
1393 952
1394#if 1 953#if 1
1395 /* Display a menu with these alternatives 954 /* Display a menu with these alternatives
1396 in the middle of frame F. */ 955 in the middle of frame F. */
@@ -1418,7 +977,7 @@ on the left of the dialog box and all following items on the right.\n\
1418 977
1419 /* Display them in a dialog box. */ 978 /* Display them in a dialog box. */
1420 BLOCK_INPUT; 979 BLOCK_INPUT;
1421 selection = w32_dialog_show (f, 0, 0, title, &error_name); 980 selection = w32_dialog_show (f, 0, title, &error_name);
1422 UNBLOCK_INPUT; 981 UNBLOCK_INPUT;
1423 982
1424 discard_menu_items (); 983 discard_menu_items ();
@@ -1429,68 +988,6 @@ on the left of the dialog box and all following items on the right.\n\
1429#endif 988#endif
1430} 989}
1431 990
1432Lisp_Object
1433get_frame_menubar_event (f, num)
1434 FRAME_PTR f;
1435 int num;
1436{
1437 Lisp_Object tail, items;
1438 int i;
1439 struct gcpro gcpro1;
1440
1441 BLOCK_INPUT;
1442
1443 GCPRO1 (items);
1444
1445 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1446 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1447
1448 for (i = 0; i < XVECTOR (items)->size; i += 4)
1449 {
1450 Lisp_Object event, binding;
1451 binding = XVECTOR (items)->contents[i + 2];
1452
1453 /* Check to see if this might be a menubar button. It might be
1454 if it is not a keymap, it is a cons cell, its car is not a
1455 keymap, and its cdr is nil. */
1456 if (NILP (Fkeymapp (binding))
1457 && CONSP (binding)
1458 && NILP (Fkeymapp (XCONS (binding)->car))
1459 && NILP (XCONS (binding)->cdr))
1460 {
1461 /* The fact that we have to check that this is a string here
1462 is the reason we don't do all this rigamarole in
1463 get_menu_event. */
1464 if (XTYPE (XVECTOR (items)->contents[i + 1]) == Lisp_String)
1465 {
1466 /* This was a menubar button. */
1467 if (--num <= 0)
1468 {
1469 UNGCPRO;
1470 UNBLOCK_INPUT;
1471 return (Fcons (XVECTOR (items)->contents[i], Qnil));
1472 }
1473 }
1474 }
1475 else
1476 {
1477 event = get_menu_event (binding, &num);
1478
1479 if (num <= 0)
1480 {
1481 UNGCPRO;
1482 UNBLOCK_INPUT;
1483 return (Fcons (XVECTOR (items)->contents[i], event));
1484 }
1485 }
1486 }
1487
1488 UNGCPRO;
1489 UNBLOCK_INPUT;
1490
1491 return (Qnil);
1492}
1493
1494/* Activate the menu bar of frame F. 991/* Activate the menu bar of frame F.
1495 This is called from keyboard.c when it gets the 992 This is called from keyboard.c when it gets the
1496 menu_bar_activate_event out of the Emacs event queue. 993 menu_bar_activate_event out of the Emacs event queue.
@@ -1515,153 +1012,556 @@ x_activate_menubar (f)
1515 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0); 1012 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
1516} 1013}
1517 1014
1518void 1015/* This callback is called from the menu bar pulldown menu
1519set_frame_menubar (f, first_time, deep_p) 1016 when the user makes a selection.
1520 FRAME_PTR f; 1017 Figure out what the user chose
1521 int first_time; 1018 and put the appropriate events into the keyboard buffer. */
1522 int deep_p; 1019
1020void
1021menubar_selection_callback (FRAME_PTR f, void * client_data)
1523{ 1022{
1524 Lisp_Object tail, items; 1023 Lisp_Object prefix, entry;
1525 HMENU hmenu; 1024 Lisp_Object vector;
1025 Lisp_Object *subprefix_stack;
1026 int submenu_depth = 0;
1526 int i; 1027 int i;
1527 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1528 menu_map mm;
1529 int count = specpdl_ptr - specpdl;
1530 1028
1531 struct buffer *prev = current_buffer; 1029 if (!f)
1532 Lisp_Object buffer; 1030 return;
1031 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1032 vector = f->menu_bar_vector;
1033 prefix = Qnil;
1034 i = 0;
1035 while (i < f->menu_bar_items_used)
1036 {
1037 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1038 {
1039 subprefix_stack[submenu_depth++] = prefix;
1040 prefix = entry;
1041 i++;
1042 }
1043 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1044 {
1045 prefix = subprefix_stack[--submenu_depth];
1046 i++;
1047 }
1048 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1049 {
1050 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1051 i += MENU_ITEMS_PANE_LENGTH;
1052 }
1053 else
1054 {
1055 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1056 /* The EMACS_INT cast avoids a warning. There's no problem
1057 as long as pointers have enough bits to hold small integers. */
1058 if ((int) (EMACS_INT) client_data == i)
1059 {
1060 int j;
1061 struct input_event buf;
1062 Lisp_Object frame;
1533 1063
1534 XSETFRAME (Vmenu_updating_frame, f); 1064 XSETFRAME (frame, f);
1065 buf.kind = menu_bar_event;
1066 buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil));
1067 kbd_buffer_store_event (&buf);
1535 1068
1536 /* We must not change the menubar when actually in use. */ 1069 for (j = 0; j < submenu_depth; j++)
1537 if (f->output_data.w32->menubar_active) 1070 if (!NILP (subprefix_stack[j]))
1538 return; 1071 {
1072 buf.kind = menu_bar_event;
1073 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1074 kbd_buffer_store_event (&buf);
1075 }
1539 1076
1540#if 0 /* I don't see why this should be needed */ 1077 if (!NILP (prefix))
1541 /* Ensure menubar is up to date when about to be used. */ 1078 {
1542 if (f->output_data.w32->pending_menu_activation && !deep_p) 1079 buf.kind = menu_bar_event;
1543 deep_p = 1; 1080 buf.frame_or_window = Fcons (frame, prefix);
1544#endif 1081 kbd_buffer_store_event (&buf);
1082 }
1545 1083
1546 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; 1084 buf.kind = menu_bar_event;
1547 specbind (Qinhibit_quit, Qt); 1085 buf.frame_or_window = Fcons (frame, entry);
1548 /* Don't let the debugger step into this code 1086 kbd_buffer_store_event (&buf);
1549 because it is not reentrant. */
1550 specbind (Qdebug_on_next_call, Qnil);
1551 1087
1552 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); 1088 return;
1553 if (NILP (Voverriding_local_map_menu_flag)) 1089 }
1554 { 1090 i += MENU_ITEMS_ITEM_LENGTH;
1555 specbind (Qoverriding_terminal_local_map, Qnil); 1091 }
1556 specbind (Qoverriding_local_map, Qnil);
1557 } 1092 }
1093}
1558 1094
1559 set_buffer_internal_1 (XBUFFER (buffer)); 1095/* Allocate a widget_value, blocking input. */
1096
1097widget_value *
1098xmalloc_widget_value ()
1099{
1100 widget_value *value;
1560 1101
1561 /* Run the Lucid hook. */
1562 call1 (Vrun_hooks, Qactivate_menubar_hook);
1563 /* If it has changed current-menubar from previous value,
1564 really recompute the menubar from the value. */
1565 if (! NILP (Vlucid_menu_bar_dirty_flag))
1566 call0 (Qrecompute_lucid_menubar);
1567 safe_run_hooks (Qmenu_bar_update_hook);
1568
1569 BLOCK_INPUT; 1102 BLOCK_INPUT;
1570 1103 value = malloc_widget_value ();
1571 GCPRO1 (items); 1104 UNBLOCK_INPUT;
1572 1105
1573 items = FRAME_MENU_BAR_ITEMS (f); 1106 return value;
1574 if (NILP (items)) 1107}
1575 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); 1108
1576 1109/* This recursively calls free_widget_value on the tree of widgets.
1577 hmenu = f->output_data.w32->menubar_widget; 1110 It must free all data that was malloc'ed for these widget_values.
1578 if (!hmenu) 1111 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1112 must be left alone. */
1113
1114void
1115free_menubar_widget_value_tree (wv)
1116 widget_value *wv;
1117{
1118 if (! wv) return;
1119
1120 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1121
1122 if (wv->contents && (wv->contents != (widget_value*)1))
1579 { 1123 {
1580 hmenu = CreateMenu (); 1124 free_menubar_widget_value_tree (wv->contents);
1581 if (!hmenu) goto error; 1125 wv->contents = (widget_value *) 0xDEADBEEF;
1582 } 1126 }
1583 else 1127 if (wv->next)
1584 { 1128 {
1585 /* Delete current contents. */ 1129 free_menubar_widget_value_tree (wv->next);
1586 while (DeleteMenu (hmenu, 0, MF_BYPOSITION)) 1130 wv->next = (widget_value *) 0xDEADBEEF;
1587 ;
1588 } 1131 }
1589 1132 BLOCK_INPUT;
1590 discard_menu_items (&mm); 1133 free_widget_value (wv);
1591 UNBLOCK_INPUT; 1134 UNBLOCK_INPUT;
1135}
1136
1137/* Return a tree of widget_value structures for a menu bar item
1138 whose event type is ITEM_KEY (with string ITEM_NAME)
1139 and whose contents come from the list of keymaps MAPS. */
1140
1141static widget_value *
1142single_submenu (item_key, item_name, maps)
1143 Lisp_Object item_key, item_name, maps;
1144{
1145 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1146 int i;
1147 int submenu_depth = 0;
1148 Lisp_Object length;
1149 int len;
1150 Lisp_Object *mapvec;
1151 widget_value **submenu_stack;
1152 int mapno;
1153 int previous_items = menu_items_used;
1154 int top_level_items = 0;
1592 1155
1593 for (i = 0; i < XVECTOR (items)->size; i += 4) 1156 length = Flength (maps);
1157 len = XINT (length);
1158
1159 /* Convert the list MAPS into a vector MAPVEC. */
1160 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1161 for (i = 0; i < len; i++)
1594 { 1162 {
1595 Lisp_Object string, binding; 1163 mapvec[i] = Fcar (maps);
1596 int keymaps; 1164 maps = Fcdr (maps);
1597 CHAR *error; 1165 }
1598 HMENU new_hmenu;
1599
1600 string = XVECTOR (items)->contents[i + 1];
1601 if (NILP (string))
1602 break;
1603
1604 binding = XVECTOR (items)->contents[i + 2];
1605
1606 if (NILP (Fkeymapp (binding))
1607 && CONSP (binding)
1608 && NILP (Fkeymapp (XCONS (binding)->car))
1609 && NILP (XCONS (binding)->cdr))
1610 {
1611 /* This is a menubar button. */
1612 Lisp_Object descrip, def;
1613 Lisp_Object enabled, item;
1614 item = Fcons (string, Fcar (binding));
1615 descrip = def = Qnil;
1616 UNGCPRO;
1617 GCPRO4 (items, item, def, string);
1618 1166
1619 def = menu_item_equiv_key (string, item, &descrip); 1167 menu_items_n_panes = 0;
1620 enabled = menu_item_enabled_p (def, 0);
1621 1168
1622 UNGCPRO; 1169 /* Loop over the given keymaps, making a pane for each map.
1623 GCPRO1 (items); 1170 But don't make a pane that is empty--ignore that map instead. */
1171 for (i = 0; i < len; i++)
1172 {
1173 if (SYMBOLP (mapvec[i])
1174 || (CONSP (mapvec[i])
1175 && NILP (Fkeymapp (mapvec[i]))))
1176 {
1177 /* Here we have a command at top level in the menu bar
1178 as opposed to a submenu. */
1179 top_level_items = 1;
1180 push_menu_pane (Qnil, Qnil);
1181 push_menu_item (item_name, Qt, item_key, mapvec[i], Qnil);
1182 }
1183 else
1184 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1185 }
1624 1186
1625 add_menu_item (&mm, hmenu, string, enabled, def, Qnil); 1187 /* Create a tree of widget_value objects
1188 representing the panes and their items. */
1189
1190 submenu_stack
1191 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1192 wv = xmalloc_widget_value ();
1193 wv->name = "menu";
1194 wv->value = 0;
1195 wv->enabled = 1;
1196 first_wv = wv;
1197 save_wv = 0;
1198 prev_wv = 0;
1199
1200 /* Loop over all panes and items made during this call
1201 and construct a tree of widget_value objects.
1202 Ignore the panes and items made by previous calls to
1203 single_submenu, even though those are also in menu_items. */
1204 i = previous_items;
1205 while (i < menu_items_used)
1206 {
1207 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1208 {
1209 submenu_stack[submenu_depth++] = save_wv;
1210 save_wv = prev_wv;
1211 prev_wv = 0;
1212 i++;
1213 }
1214 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1215 {
1216 prev_wv = save_wv;
1217 save_wv = submenu_stack[--submenu_depth];
1218 i++;
1219 }
1220 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1221 && submenu_depth != 0)
1222 i += MENU_ITEMS_PANE_LENGTH;
1223 /* Ignore a nil in the item list.
1224 It's meaningful only for dialog boxes. */
1225 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1226 i += 1;
1227 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1228 {
1229 /* Create a new pane. */
1230 Lisp_Object pane_name, prefix;
1231 char *pane_string;
1232 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1233 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1234 pane_string = (NILP (pane_name)
1235 ? "" : (char *) XSTRING (pane_name)->data);
1236 /* If there is just one top-level pane, put all its items directly
1237 under the top-level menu. */
1238 if (menu_items_n_panes == 1)
1239 pane_string = "";
1240
1241 /* If the pane has a meaningful name,
1242 make the pane a top-level menu item
1243 with its items as a submenu beneath it. */
1244 if (strcmp (pane_string, ""))
1245 {
1246 wv = xmalloc_widget_value ();
1247 if (save_wv)
1248 save_wv->next = wv;
1249 else
1250 first_wv->contents = wv;
1251 wv->name = pane_string;
1252 /* Ignore the @ that means "separate pane".
1253 This is a kludge, but this isn't worth more time. */
1254 if (!NILP (prefix) && wv->name[0] == '@')
1255 wv->name++;
1256 wv->value = 0;
1257 wv->enabled = 1;
1258 }
1259 save_wv = wv;
1260 prev_wv = 0;
1261 i += MENU_ITEMS_PANE_LENGTH;
1626 } 1262 }
1627 else 1263 else
1628 { 1264 {
1629 /* Input must not be blocked here because we call general 1265 /* Create a new item within current pane. */
1630 Lisp code and internal_condition_case_1. */ 1266 Lisp_Object item_name, enable, descrip, def;
1631 new_hmenu = create_menu_items (&mm, binding, 0); 1267 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1632 1268 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1633 if (!new_hmenu) 1269 descrip
1634 continue; 1270 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1635 1271 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1636 BLOCK_INPUT; 1272
1637 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, 1273 wv = xmalloc_widget_value ();
1638 (char *) XSTRING (string)->data); 1274 if (prev_wv)
1639 UNBLOCK_INPUT; 1275 prev_wv->next = wv;
1276 else
1277 save_wv->contents = wv;
1278
1279 wv->name = (char *) XSTRING (item_name)->data;
1280 if (!NILP (descrip))
1281 wv->key = (char *) XSTRING (descrip)->data;
1282 wv->value = 0;
1283 /* The EMACS_INT cast avoids a warning. There's no problem
1284 as long as pointers have enough bits to hold small integers. */
1285 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1286 wv->enabled = !NILP (enable);
1287 prev_wv = wv;
1288
1289 i += MENU_ITEMS_ITEM_LENGTH;
1640 } 1290 }
1641 } 1291 }
1642 1292
1293 /* If we have just one "menu item"
1294 that was originally a button, return it by itself. */
1295 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1296 {
1297 wv = first_wv->contents;
1298 free_widget_value (first_wv);
1299 return wv;
1300 }
1301
1302 return first_wv;
1303}
1304
1305/* Set the contents of the menubar widgets of frame F.
1306 The argument FIRST_TIME is currently ignored;
1307 it is set the first time this is called, from initialize_frame_menubar. */
1308
1309void
1310set_frame_menubar (f, first_time, deep_p)
1311 FRAME_PTR f;
1312 int first_time;
1313 int deep_p;
1314{
1315 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1316 Lisp_Object tail, items, frame;
1317 widget_value *wv, *first_wv, *prev_wv = 0;
1318 int i;
1319
1320 /* We must not change the menubar when actually in use. */
1321 if (f->output_data.w32->menubar_active)
1322 return;
1323
1324 XSETFRAME (Vmenu_updating_frame, f);
1325
1326 if (! menubar_widget)
1327 deep_p = 1;
1328 else if (pending_menu_activation && !deep_p)
1329 deep_p = 1;
1330
1331 wv = xmalloc_widget_value ();
1332 wv->name = "menubar";
1333 wv->value = 0;
1334 wv->enabled = 1;
1335 first_wv = wv;
1336
1337 if (deep_p)
1338 {
1339 /* Make a widget-value tree representing the entire menu trees. */
1340
1341 struct buffer *prev = current_buffer;
1342 Lisp_Object buffer;
1343 int specpdl_count = specpdl_ptr - specpdl;
1344 int previous_menu_items_used = f->menu_bar_items_used;
1345 Lisp_Object *previous_items
1346 = (Lisp_Object *) alloca (previous_menu_items_used
1347 * sizeof (Lisp_Object));
1348
1349 /* If we are making a new widget, its contents are empty,
1350 do always reinitialize them. */
1351 if (! menubar_widget)
1352 previous_menu_items_used = 0;
1353
1354 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1355 specbind (Qinhibit_quit, Qt);
1356 /* Don't let the debugger step into this code
1357 because it is not reentrant. */
1358 specbind (Qdebug_on_next_call, Qnil);
1359
1360 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1361 if (NILP (Voverriding_local_map_menu_flag))
1362 {
1363 specbind (Qoverriding_terminal_local_map, Qnil);
1364 specbind (Qoverriding_local_map, Qnil);
1365 }
1366
1367 set_buffer_internal_1 (XBUFFER (buffer));
1368
1369 /* Run the Lucid hook. */
1370 call1 (Vrun_hooks, Qactivate_menubar_hook);
1371 /* If it has changed current-menubar from previous value,
1372 really recompute the menubar from the value. */
1373 if (! NILP (Vlucid_menu_bar_dirty_flag))
1374 call0 (Qrecompute_lucid_menubar);
1375 safe_run_hooks (Qmenu_bar_update_hook);
1376 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1377
1378 items = FRAME_MENU_BAR_ITEMS (f);
1379
1380 inhibit_garbage_collection ();
1381
1382 /* Save the frame's previous menu bar contents data. */
1383 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1384 previous_menu_items_used * sizeof (Lisp_Object));
1385
1386 /* Fill in the current menu bar contents. */
1387 menu_items = f->menu_bar_vector;
1388 menu_items_allocated = XVECTOR (menu_items)->size;
1389 init_menu_items ();
1390 for (i = 0; i < XVECTOR (items)->size; i += 4)
1391 {
1392 Lisp_Object key, string, maps;
1393
1394 key = XVECTOR (items)->contents[i];
1395 string = XVECTOR (items)->contents[i + 1];
1396 maps = XVECTOR (items)->contents[i + 2];
1397 if (NILP (string))
1398 break;
1399
1400 wv = single_submenu (key, string, maps);
1401 if (prev_wv)
1402 prev_wv->next = wv;
1403 else
1404 first_wv->contents = wv;
1405 /* Don't set wv->name here; GC during the loop might relocate it. */
1406 wv->enabled = 1;
1407 prev_wv = wv;
1408 }
1409
1410 finish_menu_items ();
1411
1412 set_buffer_internal_1 (prev);
1413 unbind_to (specpdl_count, Qnil);
1414
1415 /* If there has been no change in the Lisp-level contents
1416 of the menu bar, skip redisplaying it. Just exit. */
1417
1418 for (i = 0; i < previous_menu_items_used; i++)
1419 if (menu_items_used == i
1420 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1421 break;
1422 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1423 {
1424 free_menubar_widget_value_tree (first_wv);
1425 menu_items = Qnil;
1426
1427 return;
1428 }
1429
1430 /* Now GC cannot happen during the lifetime of the widget_value,
1431 so it's safe to store data from a Lisp_String. */
1432 wv = first_wv->contents;
1433 for (i = 0; i < XVECTOR (items)->size; i += 4)
1434 {
1435 Lisp_Object string;
1436 string = XVECTOR (items)->contents[i + 1];
1437 if (NILP (string))
1438 break;
1439 wv->name = (char *) XSTRING (string)->data;
1440 wv = wv->next;
1441 }
1442
1443 f->menu_bar_vector = menu_items;
1444 f->menu_bar_items_used = menu_items_used;
1445 menu_items = Qnil;
1446 }
1447 else
1448 {
1449 /* Make a widget-value tree containing
1450 just the top level menu bar strings.
1451
1452 It turns out to be worth comparing the new contents with the
1453 previous contents to avoid unnecessary rebuilding even of just
1454 the top-level menu bar, which turns out to be fairly slow. We
1455 co-opt f->menu_bar_vector for this purpose, since its contents
1456 are effectively discarded at this point anyway.
1457
1458 Note that the lisp-level hooks have already been run by
1459 update_menu_bar - it's kinda a shame the code is duplicated
1460 above as well for deep_p, but there we are. */
1461
1462 items = FRAME_MENU_BAR_ITEMS (f);
1463
1464 /* If there has been no change in the Lisp-level contents of just
1465 the menu bar itself, skip redisplaying it. Just exit. */
1466 for (i = 0; i < f->menu_bar_items_used; i += 4)
1467 if (i == XVECTOR (items)->size
1468 || (XVECTOR (f->menu_bar_vector)->contents[i]
1469 != XVECTOR (items)->contents[i]))
1470 break;
1471 if (i == XVECTOR (items)->size && i == f->menu_bar_items_used && i != 0)
1472 return;
1473
1474 for (i = 0; i < XVECTOR (items)->size; i += 4)
1475 {
1476 Lisp_Object string;
1477
1478 string = XVECTOR (items)->contents[i + 1];
1479 if (NILP (string))
1480 break;
1481
1482 wv = xmalloc_widget_value ();
1483 wv->name = (char *) XSTRING (string)->data;
1484 wv->value = 0;
1485 wv->enabled = 1;
1486 /* This prevents lwlib from assuming this
1487 menu item is really supposed to be empty. */
1488 /* The EMACS_INT cast avoids a warning.
1489 This value just has to be different from small integers. */
1490 wv->call_data = (void *) (EMACS_INT) (-1);
1491
1492 if (prev_wv)
1493 prev_wv->next = wv;
1494 else
1495 first_wv->contents = wv;
1496 prev_wv = wv;
1497 }
1498
1499 /* Remember the contents of FRAME_MENU_BAR_ITEMS (f) in
1500 f->menu_bar_vector, so we can check whether the top-level
1501 menubar contents have changed next time. */
1502 if (XVECTOR (f->menu_bar_vector)->size < XVECTOR (items)->size)
1503 f->menu_bar_vector
1504 = Fmake_vector (make_number (XVECTOR (items)->size), Qnil);
1505 bcopy (XVECTOR (items)->contents,
1506 XVECTOR (f->menu_bar_vector)->contents,
1507 XVECTOR (items)->size * sizeof (Lisp_Object));
1508 f->menu_bar_items_used = XVECTOR (items)->size;
1509 }
1510
1511 /* Create or update the menu bar widget. */
1512
1643 BLOCK_INPUT; 1513 BLOCK_INPUT;
1514
1515 if (menubar_widget)
1516 {
1517 /* Empty current menubar, rather than creating a fresh one. */
1518 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1519 ;
1520 }
1521 else
1522 {
1523 menubar_widget = CreateMenu ();
1524 }
1525 fill_in_menu (menubar_widget, first_wv->contents);
1526
1527 free_menubar_widget_value_tree (first_wv);
1528
1644 { 1529 {
1645 HMENU old = f->output_data.w32->menubar_widget; 1530 HMENU old_widget = f->output_data.w32->menubar_widget;
1646 SetMenu (FRAME_W32_WINDOW (f), hmenu); 1531
1647 f->output_data.w32->menubar_widget = hmenu; 1532 f->output_data.w32->menubar_widget = menubar_widget;
1533 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1648 /* Causes flicker when menu bar is updated 1534 /* Causes flicker when menu bar is updated
1649 DrawMenuBar (FRAME_W32_WINDOW (f)); */ 1535 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1650 1536
1651 /* Force the window size to be recomputed so that the frame's text 1537 /* Force the window size to be recomputed so that the frame's text
1652 area remains the same, if menubar has just been created. */ 1538 area remains the same, if menubar has just been created. */
1653 if (old == NULL) 1539 if (old_widget == NULL)
1654 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); 1540 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1655 } 1541 }
1656 1542
1657 error:
1658 set_buffer_internal_1 (prev);
1659 UNGCPRO;
1660 UNBLOCK_INPUT; 1543 UNBLOCK_INPUT;
1661 unbind_to (count, Qnil);
1662} 1544}
1663 1545
1664void 1546/* Called from Fx_create_frame to create the initial menubar of a frame
1547 before it is mapped, so that the window is mapped with the menubar already
1548 there instead of us tacking it on later and thrashing the window after it
1549 is visible. */
1550
1551void
1552initialize_frame_menubar (f)
1553 FRAME_PTR f;
1554{
1555 /* This function is called before the first chance to redisplay
1556 the frame. It has to be, so the frame will have the right size. */
1557 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1558 set_frame_menubar (f, 1, 1);
1559}
1560
1561/* Get rid of the menu bar of frame F, and free its storage.
1562 This is used when deleting a frame, and when turning off the menu bar. */
1563
1564void
1665free_frame_menubar (f) 1565free_frame_menubar (f)
1666 FRAME_PTR f; 1566 FRAME_PTR f;
1667{ 1567{
@@ -1676,279 +1576,292 @@ free_frame_menubar (f)
1676 1576
1677 UNBLOCK_INPUT; 1577 UNBLOCK_INPUT;
1678} 1578}
1679/* Called from Fw32_create_frame to create the initial menubar of a frame
1680 before it is mapped, so that the window is mapped with the menubar already
1681 there instead of us tacking it on later and thrashing the window after it
1682 is visible. */
1683void
1684initialize_frame_menubar (f)
1685 FRAME_PTR f;
1686{
1687 set_frame_menubar (f, 1, 1);
1688}
1689
1690#if 0
1691/* If the mouse has moved to another menu bar item,
1692 return 1 and unread a button press event for that item.
1693 Otherwise return 0. */
1694
1695static int
1696check_mouse_other_menu_bar (f)
1697 FRAME_PTR f;
1698{
1699 FRAME_PTR new_f;
1700 Lisp_Object bar_window;
1701 int part;
1702 Lisp_Object x, y;
1703 unsigned long time;
1704
1705 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1706 1579
1707 if (f == new_f && other_menu_bar_item_p (f, x, y))
1708 {
1709 unread_menu_bar_button (f, x);
1710 return 1;
1711 }
1712
1713 return 0;
1714}
1715#endif
1716 1580
1581/* w32_menu_show actually displays a menu using the panes and items in
1582 menu_items and returns the value selected from it; we assume input
1583 is blocked by the caller. */
1717 1584
1718#if 0 1585/* F is the frame the menu is for.
1719static HMENU 1586 X and Y are the frame-relative specified position,
1720create_menu (keymaps, error) 1587 relative to the inside upper left corner of the frame F.
1588 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1589 KEYMAPS is 1 if this menu was specified with keymaps;
1590 in that case, we return a list containing the chosen item's value
1591 and perhaps also the pane's prefix.
1592 TITLE is the specified menu title.
1593 ERROR is a place to store an error message string in case of failure.
1594 (We return nil on failure, but the value doesn't actually matter.) */
1595
1596static Lisp_Object
1597w32_menu_show (f, x, y, for_click, keymaps, title, error)
1598 FRAME_PTR f;
1599 int x;
1600 int y;
1601 int for_click;
1721 int keymaps; 1602 int keymaps;
1603 Lisp_Object title;
1722 char **error; 1604 char **error;
1723{ 1605{
1724 HMENU hmenu = NULL; /* the menu we are currently working on */
1725 HMENU first_hmenu = NULL;
1726
1727 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1728 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1729 sizeof (Lisp_Object));
1730 int submenu_depth = 0;
1731 int i; 1606 int i;
1732 1607 int menu_item_selection;
1608 HMENU menu;
1609 POINT pos;
1610 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1611 widget_value **submenu_stack
1612 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1613 Lisp_Object *subprefix_stack
1614 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1615 int submenu_depth = 0;
1616
1617 int first_pane;
1618 int next_release_must_exit = 0;
1619
1620 *error = NULL;
1621
1733 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) 1622 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1734 { 1623 {
1735 *error = "Empty menu"; 1624 *error = "Empty menu";
1736 return NULL; 1625 return Qnil;
1737 } 1626 }
1738 1627
1739 i = 0; 1628 /* Create a tree of widget_value objects
1740 1629 representing the panes and their items. */
1630 wv = xmalloc_widget_value ();
1631 wv->name = "menu";
1632 wv->value = 0;
1633 wv->enabled = 1;
1634 first_wv = wv;
1635 first_pane = 1;
1636
1741 /* Loop over all panes and items, filling in the tree. */ 1637 /* Loop over all panes and items, filling in the tree. */
1742 1638 i = 0;
1743 while (i < menu_items_used) 1639 while (i < menu_items_used)
1744 { 1640 {
1745 if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) 1641 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1746 { 1642 {
1747 submenu_stack[submenu_depth++] = hmenu; 1643 submenu_stack[submenu_depth++] = save_wv;
1644 save_wv = prev_wv;
1645 prev_wv = 0;
1646 first_pane = 1;
1748 i++; 1647 i++;
1749 } 1648 }
1750 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) 1649 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1751 { 1650 {
1752 hmenu = submenu_stack[--submenu_depth]; 1651 prev_wv = save_wv;
1652 save_wv = submenu_stack[--submenu_depth];
1653 first_pane = 0;
1753 i++; 1654 i++;
1754 } 1655 }
1755#if 0 1656 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1756else if (EQ (XVECTOR (menu_items)->contents[i], Qt) 1657 && submenu_depth != 0)
1757 && submenu_depth != 0) 1658 i += MENU_ITEMS_PANE_LENGTH;
1758 i += MENU_ITEMS_PANE_LENGTH;
1759#endif
1760 /* Ignore a nil in the item list. 1659 /* Ignore a nil in the item list.
1761 It's meaningful only for dialog boxes. */ 1660 It's meaningful only for dialog boxes. */
1762else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) 1661 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1763 i += 1; 1662 i += 1;
1764else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) 1663 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1765 { 1664 {
1766 /* Create a new pane. */ 1665 /* Create a new pane. */
1767 1666 Lisp_Object pane_name, prefix;
1768 Lisp_Object pane_name; 1667 char *pane_string;
1769 char *pane_string; 1668 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1770 1669 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1771 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; 1670 pane_string = (NILP (pane_name)
1772 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); 1671 ? "" : (char *) XSTRING (pane_name)->data);
1773 1672 /* If there is just one top-level pane, put all its items directly
1774 if (!hmenu || strcmp (pane_string, "")) 1673 under the top-level menu. */
1775 { 1674 if (menu_items_n_panes == 1)
1776 HMENU new_hmenu = CreatePopupMenu (); 1675 pane_string = "";
1777 1676
1778 if (!new_hmenu) 1677 /* If the pane has a meaningful name,
1779 { 1678 make the pane a top-level menu item
1780 *error = "Could not create menu pane"; 1679 with its items as a submenu beneath it. */
1781 goto error; 1680 if (!keymaps && strcmp (pane_string, ""))
1782 } 1681 {
1783 1682 wv = xmalloc_widget_value ();
1784 if (hmenu) 1683 if (save_wv)
1785 { 1684 save_wv->next = wv;
1786 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string); 1685 else
1787 } 1686 first_wv->contents = wv;
1788 1687 wv->name = pane_string;
1789 hmenu = new_hmenu; 1688 if (keymaps && !NILP (prefix))
1790 1689 wv->name++;
1791 if (!first_hmenu) first_hmenu = hmenu; 1690 wv->value = 0;
1792 } 1691 wv->enabled = 1;
1793 i += MENU_ITEMS_PANE_LENGTH; 1692 save_wv = wv;
1794 } 1693 prev_wv = 0;
1795else 1694 }
1796 { 1695 else if (first_pane)
1797 /* Create a new item within current pane. */ 1696 {
1798 1697 save_wv = wv;
1799 Lisp_Object item_name, enable, descrip; 1698 prev_wv = 0;
1800 UINT fuFlags; 1699 }
1801 1700 first_pane = 0;
1802 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; 1701 i += MENU_ITEMS_PANE_LENGTH;
1803 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; 1702 }
1804 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; 1703 else
1805 1704 {
1806 if (name_is_separator (item_name)) 1705 /* Create a new item within current pane. */
1807 fuFlags = MF_SEPARATOR; 1706 Lisp_Object item_name, enable, descrip, def;
1808 else if (NILP (enable) || !XUINT (enable)) 1707 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1809 fuFlags = MF_STRING | MF_GRAYED; 1708 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1810 else 1709 descrip
1811 fuFlags = MF_STRING; 1710 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1812 1711 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1813 AppendMenu (hmenu, 1712
1814 fuFlags, 1713 wv = xmalloc_widget_value ();
1815 i, 1714 if (prev_wv)
1816 (char *) XSTRING (item_name)->data); 1715 prev_wv->next = wv;
1817 1716 else
1818 // if (!NILP (descrip)) 1717 save_wv->contents = wv;
1819 // hmenu->key = (char *) XSTRING (descrip)->data; 1718 wv->name = (char *) XSTRING (item_name)->data;
1820 1719 if (!NILP (descrip))
1821 i += MENU_ITEMS_ITEM_LENGTH; 1720 wv->key = (char *) XSTRING (descrip)->data;
1822 } 1721 wv->value = 0;
1823} 1722 /* Use the contents index as call_data, since we are
1824 1723 restricted to 16-bits.. */
1825 return (first_hmenu); 1724 wv->call_data = (void *) (EMACS_INT) i;
1826 1725 wv->enabled = !NILP (enable);
1827 error: 1726 prev_wv = wv;
1828 if (first_hmenu) DestroyMenu (first_hmenu); 1727
1829 return (NULL); 1728 i += MENU_ITEMS_ITEM_LENGTH;
1830} 1729 }
1831 1730 }
1832#endif
1833
1834/* w32menu_show actually displays a menu using the panes and items in
1835 menu_items and returns the value selected from it.
1836 There are two versions of w32menu_show, one for Xt and one for Xlib.
1837 Both assume input is blocked by the caller. */
1838
1839/* F is the frame the menu is for.
1840 X and Y are the frame-relative specified position,
1841 relative to the inside upper left corner of the frame F.
1842 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1843 KEYMAPS is 1 if this menu was specified with keymaps;
1844 in that case, we return a list containing the chosen item's value
1845 and perhaps also the pane's prefix.
1846 TITLE is the specified menu title.
1847 ERROR is a place to store an error message string in case of failure.
1848 (We return nil on failure, but the value doesn't actually matter.) */
1849
1850 1731
1851static Lisp_Object 1732 /* Deal with the title, if it is non-nil. */
1852w32menu_show (f, x, y, menu, hmenu, error) 1733 if (!NILP (title))
1853 FRAME_PTR f;
1854 int x;
1855 int y;
1856 Lisp_Object menu;
1857 HMENU hmenu;
1858 char **error;
1859{
1860 int i , menu_selection;
1861 POINT pos;
1862
1863 *error = NULL;
1864
1865 if (!hmenu)
1866 { 1734 {
1867 *error = "Empty menu"; 1735 widget_value *wv_title = xmalloc_widget_value ();
1868 return Qnil; 1736 widget_value *wv_sep = xmalloc_widget_value ();
1737
1738 /* Maybe replace this separator with a bitmap or owner-draw item
1739 so that it looks better. Having two separators looks odd. */
1740 wv_sep->name = "--";
1741 wv_sep->next = first_wv->contents;
1742
1743 wv_title->name = (char *) XSTRING (title)->data;
1744 /* Handle title specially, so it looks better. */
1745 wv_title->title = True;
1746 wv_title->next = wv_sep;
1747 first_wv->contents = wv_title;
1869 } 1748 }
1870 1749
1750 /* Actually create the menu. */
1751 menu = CreatePopupMenu ();
1752 fill_in_menu (menu, first_wv->contents);
1753
1754 /* Adjust coordinates to be root-window-relative. */
1871 pos.x = x; 1755 pos.x = x;
1872 pos.y = y; 1756 pos.y = y;
1873
1874 /* Offset the coordinates to root-relative. */
1875 ClientToScreen (FRAME_W32_WINDOW (f), &pos); 1757 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1876 1758
1877#if 0 1759 /* Free the widget_value objects we used to specify the contents. */
1878 /* If the mouse moves out of the menu before we show the menu, 1760 free_menubar_widget_value_tree (first_wv);
1879 don't show it at all. */ 1761
1880 if (check_mouse_other_menu_bar (f)) 1762 /* No selection has been chosen yet. */
1881 { 1763 menu_item_selection = 0;
1882 DestroyMenu (hmenu);
1883 return Qnil;
1884 }
1885#endif
1886 1764
1887 /* Display the menu. */ 1765 /* Display the menu. */
1888 menu_selection = SendMessage (FRAME_W32_WINDOW (f), 1766 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1889 WM_EMACS_TRACKPOPUPMENU, 1767 WM_EMACS_TRACKPOPUPMENU,
1890 (WPARAM)hmenu, (LPARAM)&pos); 1768 (WPARAM)menu, (LPARAM)&pos);
1891 1769
1892 /* Clean up extraneous mouse events which might have been generated 1770 /* Clean up extraneous mouse events which might have been generated
1893 during the call. */ 1771 during the call. */
1894 discard_mouse_events (); 1772 discard_mouse_events ();
1895 1773
1896 if (menu_selection == -1) 1774 DestroyMenu (menu);
1897 { 1775
1898 *error = "Invalid menu specification";
1899 return Qnil;
1900 }
1901
1902 /* Find the selected item, and its pane, to return 1776 /* Find the selected item, and its pane, to return
1903 the proper value. */ 1777 the proper value. */
1904 1778 if (menu_item_selection != 0)
1905#if 1
1906 if (menu_selection > 0)
1907 {
1908 return get_menu_event (menu, &menu_selection);
1909 }
1910#else
1911 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1912 { 1779 {
1913 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]); 1780 Lisp_Object prefix, entry;
1781
1782 prefix = Qnil;
1783 i = 0;
1784 while (i < menu_items_used)
1785 {
1786 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1787 {
1788 subprefix_stack[submenu_depth++] = prefix;
1789 prefix = entry;
1790 i++;
1791 }
1792 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1793 {
1794 prefix = subprefix_stack[--submenu_depth];
1795 i++;
1796 }
1797 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1798 {
1799 prefix
1800 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1801 i += MENU_ITEMS_PANE_LENGTH;
1802 }
1803 /* Ignore a nil in the item list.
1804 It's meaningful only for dialog boxes. */
1805 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1806 i += 1;
1807 else
1808 {
1809 entry
1810 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1811 if (menu_item_selection == i)
1812 {
1813 if (keymaps != 0)
1814 {
1815 int j;
1816
1817 entry = Fcons (entry, Qnil);
1818 if (!NILP (prefix))
1819 entry = Fcons (prefix, entry);
1820 for (j = submenu_depth - 1; j >= 0; j--)
1821 if (!NILP (subprefix_stack[j]))
1822 entry = Fcons (subprefix_stack[j], entry);
1823 }
1824 return entry;
1825 }
1826 i += MENU_ITEMS_ITEM_LENGTH;
1827 }
1828 }
1914 } 1829 }
1915#endif
1916 1830
1917 return Qnil; 1831 return Qnil;
1918} 1832}
1833
1919 1834
1920#if 0 1835static char * button_names [] = {
1921static char * button_names [] =
1922{
1923 "button1", "button2", "button3", "button4", "button5", 1836 "button1", "button2", "button3", "button4", "button5",
1924 "button6", "button7", "button8", "button9", "button10" 1837 "button6", "button7", "button8", "button9", "button10" };
1925};
1926 1838
1927static Lisp_Object 1839static Lisp_Object
1928w32_dialog_show (f, menubarp, keymaps, title, error) 1840w32_dialog_show (f, keymaps, title, error)
1929 FRAME_PTR f; 1841 FRAME_PTR f;
1930 int menubarp;
1931 int keymaps; 1842 int keymaps;
1932 Lisp_Object title; 1843 Lisp_Object title;
1933 char **error; 1844 char **error;
1934{ 1845{
1935 int i, nb_buttons=0; 1846 int i, nb_buttons=0;
1936 HMENU hmenu;
1937 char dialog_name[6]; 1847 char dialog_name[6];
1938 1848 int menu_item_selection;
1849
1850 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1851
1939 /* Number of elements seen so far, before boundary. */ 1852 /* Number of elements seen so far, before boundary. */
1940 int left_count = 0; 1853 int left_count = 0;
1941 /* 1 means we've seen the boundary between left-hand elts and right-hand. */ 1854 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1942 int boundary_seen = 0; 1855 int boundary_seen = 0;
1943 1856
1944 *error = NULL; 1857 *error = NULL;
1945 1858
1946 if (menu_items_n_panes > 1) 1859 if (menu_items_n_panes > 1)
1947 { 1860 {
1948 *error = "Multiple panes in dialog box"; 1861 *error = "Multiple panes in dialog box";
1949 return Qnil; 1862 return Qnil;
1950 } 1863 }
1951 1864
1952 /* Create a tree of widget_value objects 1865 /* Create a tree of widget_value objects
1953 representing the text label and buttons. */ 1866 representing the text label and buttons. */
1954 { 1867 {
@@ -1958,14 +1871,14 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
1958 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; 1871 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1959 pane_string = (NILP (pane_name) 1872 pane_string = (NILP (pane_name)
1960 ? "" : (char *) XSTRING (pane_name)->data); 1873 ? "" : (char *) XSTRING (pane_name)->data);
1961 prev_wv = malloc_widget_value (); 1874 prev_wv = xmalloc_widget_value ();
1962 prev_wv->value = pane_string; 1875 prev_wv->value = pane_string;
1963 if (keymaps && !NILP (prefix)) 1876 if (keymaps && !NILP (prefix))
1964 prev_wv->name++; 1877 prev_wv->name++;
1965 prev_wv->enabled = 1; 1878 prev_wv->enabled = 1;
1966 prev_wv->name = "message"; 1879 prev_wv->name = "message";
1967 first_wv = prev_wv; 1880 first_wv = prev_wv;
1968 1881
1969 /* Loop over all panes and items, filling in the tree. */ 1882 /* Loop over all panes and items, filling in the tree. */
1970 i = MENU_ITEMS_PANE_LENGTH; 1883 i = MENU_ITEMS_PANE_LENGTH;
1971 while (i < menu_items_used) 1884 while (i < menu_items_used)
@@ -1992,14 +1905,14 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
1992 i++; 1905 i++;
1993 continue; 1906 continue;
1994 } 1907 }
1995 if (nb_buttons >= 10) 1908 if (nb_buttons >= 9)
1996 { 1909 {
1997 free_menubar_widget_value_tree (first_wv); 1910 free_menubar_widget_value_tree (first_wv);
1998 *error = "Too many dialog items"; 1911 *error = "Too many dialog items";
1999 return Qnil; 1912 return Qnil;
2000 } 1913 }
2001 1914
2002 wv = malloc_widget_value (); 1915 wv = xmalloc_widget_value ();
2003 prev_wv->next = wv; 1916 prev_wv->next = wv;
2004 wv->name = (char *) button_names[nb_buttons]; 1917 wv->name = (char *) button_names[nb_buttons];
2005 if (!NILP (descrip)) 1918 if (!NILP (descrip))
@@ -2008,22 +1921,22 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
2008 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; 1921 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2009 wv->enabled = !NILP (enable); 1922 wv->enabled = !NILP (enable);
2010 prev_wv = wv; 1923 prev_wv = wv;
2011 1924
2012 if (! boundary_seen) 1925 if (! boundary_seen)
2013 left_count++; 1926 left_count++;
2014 1927
2015 nb_buttons++; 1928 nb_buttons++;
2016 i += MENU_ITEMS_ITEM_LENGTH; 1929 i += MENU_ITEMS_ITEM_LENGTH;
2017 } 1930 }
2018 1931
2019 /* If the boundary was not specified, 1932 /* If the boundary was not specified,
2020 by default put half on the left and half on the right. */ 1933 by default put half on the left and half on the right. */
2021 if (! boundary_seen) 1934 if (! boundary_seen)
2022 left_count = nb_buttons - nb_buttons / 2; 1935 left_count = nb_buttons - nb_buttons / 2;
2023 1936
2024 wv = malloc_widget_value (); 1937 wv = xmalloc_widget_value ();
2025 wv->name = dialog_name; 1938 wv->name = dialog_name;
2026 1939
2027 /* Dialog boxes use a really stupid name encoding 1940 /* Dialog boxes use a really stupid name encoding
2028 which specifies how many buttons to use 1941 which specifies how many buttons to use
2029 and how many buttons are on the right. 1942 and how many buttons are on the right.
@@ -2038,76 +1951,39 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
2038 wv->contents = first_wv; 1951 wv->contents = first_wv;
2039 first_wv = wv; 1952 first_wv = wv;
2040 } 1953 }
2041 1954
2042 /* Actually create the dialog. */ 1955 /* Actually create the dialog. */
2043 dialog_id = ++popup_id_tick; 1956#if 0
1957 dialog_id = widget_id_tick++;
2044 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, 1958 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2045 f->output_data.w32->widget, 1, 0, 1959 f->output_data.w32->widget, 1, 0,
2046 dialog_selection_callback, 0); 1960 dialog_selection_callback, 0);
2047#if 0 /* This causes crashes, and seems to be redundant -- rms. */
2048 lw_modify_all_widgets (dialog_id, first_wv, True);
2049#endif
2050 lw_modify_all_widgets (dialog_id, first_wv->contents, True); 1961 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1962#endif
1963
2051 /* Free the widget_value objects we used to specify the contents. */ 1964 /* Free the widget_value objects we used to specify the contents. */
2052 free_menubar_widget_value_tree (first_wv); 1965 free_menubar_widget_value_tree (first_wv);
2053 1966
2054 /* No selection has been chosen yet. */ 1967 /* No selection has been chosen yet. */
2055 menu_item_selection = 0; 1968 menu_item_selection = 0;
2056 1969
2057 /* Display the menu. */ 1970 /* Display the menu. */
1971#if 0
2058 lw_pop_up_all_widgets (dialog_id); 1972 lw_pop_up_all_widgets (dialog_id);
2059 1973 popup_activated_flag = 1;
1974
2060 /* Process events that apply to the menu. */ 1975 /* Process events that apply to the menu. */
2061 while (1) 1976 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2062 {
2063 XEvent event;
2064
2065 XtAppNextEvent (Xt_app_con, &event);
2066 if (event.type == ButtonRelease)
2067 {
2068 XtDispatchEvent (&event);
2069 break;
2070 }
2071 else if (event.type == Expose)
2072 process_expose_from_menu (event);
2073 XtDispatchEvent (&event);
2074 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
2075 {
2076 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
2077 1977
2078 if (queue_tmp != NULL) 1978 lw_destroy_all_widgets (dialog_id);
2079 { 1979#endif
2080 queue_tmp->event = event;
2081 queue_tmp->next = queue;
2082 queue = queue_tmp;
2083 }
2084 }
2085 }
2086 pop_down:
2087 1980
2088 /* State that no mouse buttons are now held.
2089 That is not necessarily true, but the fiction leads to reasonable
2090 results, and it is a pain to ask which are actually held now
2091 or track this in the loop above. */
2092 w32_mouse_grabbed = 0;
2093
2094 /* Unread any events that we got but did not handle. */
2095 while (queue != NULL)
2096 {
2097 queue_tmp = queue;
2098 XPutBackEvent (XDISPLAY &queue_tmp->event);
2099 queue = queue_tmp->next;
2100 free ((char *)queue_tmp);
2101 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2102 interrupt_input_pending = 1;
2103 }
2104
2105 /* Find the selected item, and its pane, to return 1981 /* Find the selected item, and its pane, to return
2106 the proper value. */ 1982 the proper value. */
2107 if (menu_item_selection != 0) 1983 if (menu_item_selection != 0)
2108 { 1984 {
2109 Lisp_Object prefix; 1985 Lisp_Object prefix;
2110 1986
2111 prefix = Qnil; 1987 prefix = Qnil;
2112 i = 0; 1988 i = 0;
2113 while (i < menu_items_used) 1989 while (i < menu_items_used)
@@ -2124,7 +2000,7 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
2124 { 2000 {
2125 entry 2001 entry
2126 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; 2002 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2127 if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) 2003 if (menu_item_selection == i)
2128 { 2004 {
2129 if (keymaps != 0) 2005 if (keymaps != 0)
2130 { 2006 {
@@ -2138,21 +2014,121 @@ w32_dialog_show (f, menubarp, keymaps, title, error)
2138 } 2014 }
2139 } 2015 }
2140 } 2016 }
2141 2017
2142 return Qnil; 2018 return Qnil;
2143} 2019}
2020
2021
2022/* Is this item a separator? */
2023static int
2024name_is_separator (name)
2025 char *name;
2026{
2027 /* Check if name string consists of only dashes ('-') */
2028 while (*name == '-') name++;
2029 return (*name == '\0');
2030}
2031
2032
2033/* Indicate boundary between left and right. */
2034static int
2035add_left_right_boundary (HMENU menu)
2036{
2037 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2038}
2039
2040static int
2041add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2042{
2043 UINT fuFlags;
2044 char *out_string;
2045
2046 if (name_is_separator (wv->name))
2047 fuFlags = MF_SEPARATOR;
2048 else
2049 {
2050 if (wv->enabled)
2051 fuFlags = MF_STRING;
2052 else
2053 fuFlags = MF_STRING | MF_GRAYED;
2054
2055 if (wv->key != NULL)
2056 {
2057 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2058 strcpy (out_string, wv->name);
2059 strcat (out_string, "\t");
2060 strcat (out_string, wv->key);
2061 }
2062 else
2063 out_string = wv->name;
2064
2065 if (wv->title)
2066 {
2067#if 0 /* no GC while popup menu is active */
2068 out_string = LocalAlloc (0, strlen (wv->name) + 1);
2069 strcpy (out_string, wv->name);
2144#endif 2070#endif
2071 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2072 }
2073 }
2074
2075 if (item != NULL)
2076 fuFlags = MF_POPUP;
2077
2078 return AppendMenu (menu,
2079 fuFlags,
2080 item != NULL ? (UINT) item : (UINT) wv->call_data,
2081 (fuFlags == MF_SEPARATOR) ? NULL: out_string );
2082}
2083
2084/* Construct native Windows menu(bar) based on widget_value tree. */
2085static int
2086fill_in_menu (HMENU menu, widget_value *wv)
2087{
2088 int items_added = 0;
2145 2089
2090 for ( ; wv != NULL; wv = wv->next)
2091 {
2092 if (wv->contents)
2093 {
2094 HMENU sub_menu = CreatePopupMenu ();
2095
2096 if (sub_menu == NULL)
2097 return 0;
2098
2099 if (!fill_in_menu (sub_menu, wv->contents) ||
2100 !add_menu_item (menu, wv, sub_menu))
2101 {
2102 DestroyMenu (sub_menu);
2103 return 0;
2104 }
2105 }
2106 else
2107 {
2108 if (!add_menu_item (menu, wv, NULL))
2109 return 0;
2110 }
2111 }
2112 return 1;
2113}
2114
2115#endif /* HAVE_MENUS */
2116
2146syms_of_w32menu () 2117syms_of_w32menu ()
2147{ 2118{
2119 staticpro (&menu_items);
2120 menu_items = Qnil;
2121
2148 Qdebug_on_next_call = intern ("debug-on-next-call"); 2122 Qdebug_on_next_call = intern ("debug-on-next-call");
2149 staticpro (&Qdebug_on_next_call); 2123 staticpro (&Qdebug_on_next_call);
2150 2124
2151 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame, 2125 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2152 "Frame for which we are updating a menu\n\ 2126 "Frame for which we are updating a menu.\n\
2153The enable predicate for a menu command should check this variable."); 2127The enable predicate for a menu command should check this variable.");
2154 Vmenu_updating_frame = Qnil; 2128 Vmenu_updating_frame = Qnil;
2155 2129
2156 defsubr (&Sx_popup_menu); 2130 defsubr (&Sx_popup_menu);
2131#ifdef HAVE_MENUS
2157 defsubr (&Sx_popup_dialog); 2132 defsubr (&Sx_popup_dialog);
2133#endif
2158} 2134}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-21 23:00:00 +0000