Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-483
[bpt/emacs.git] / src / w32menu.c
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986,88,93,94,96,98,1999,2003 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include <config.h>
22 #include <signal.h>
23
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "termhooks.h"
27 #include "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "blockinput.h"
32 #include "buffer.h"
33 #include "charset.h"
34 #include "coding.h"
35
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
38 #include "w32term.h"
39
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
42 #ifndef makedev
43 #include <sys/types.h>
44 #endif
45
46 #include "dispextern.h"
47
48 #undef HAVE_MULTILINGUAL_MENU
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
50
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
53
54 typedef void * XtPointer;
55 typedef char Boolean;
56
57 enum button_type
58 {
59 BUTTON_TYPE_NONE,
60 BUTTON_TYPE_TOGGLE,
61 BUTTON_TYPE_RADIO
62 };
63
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
65 for Windows. */
66 typedef struct _widget_value
67 {
68 /* name of widget */
69 char* name;
70 /* value (meaning depend on widget type) */
71 char* value;
72 /* keyboard equivalent. no implications for XtTranslations */
73 char* key;
74 /* Help string or nil if none.
75 GC finds this string through the frame's menu_bar_vector
76 or through menu_items. */
77 Lisp_Object help;
78 /* true if enabled */
79 Boolean enabled;
80 /* true if selected */
81 Boolean selected;
82 /* The type of a button. */
83 enum button_type button_type;
84 /* true if menu title */
85 Boolean title;
86 #if 0
87 /* true if was edited (maintained by get_value) */
88 Boolean edited;
89 /* true if has changed (maintained by lw library) */
90 change_type change;
91 /* true if this widget itself has changed,
92 but not counting the other widgets found in the `next' field. */
93 change_type this_one_change;
94 #endif
95 /* Contents of the sub-widgets, also selected slot for checkbox */
96 struct _widget_value* contents;
97 /* data passed to callback */
98 XtPointer call_data;
99 /* next one in the list */
100 struct _widget_value* next;
101 #if 0
102 /* slot for the toolkit dependent part. Always initialize to NULL. */
103 void* toolkit_data;
104 /* tell us if we should free the toolkit data slot when freeing the
105 widget_value itself. */
106 Boolean free_toolkit_data;
107
108 /* we resource the widget_value structures; this points to the next
109 one on the free list if this one has been deallocated.
110 */
111 struct _widget_value *free_list;
112 #endif
113 } widget_value;
114
115 /* Local memory management */
116 #define local_heap (GetProcessHeap ())
117 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
118 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
119
120 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
121 #define free_widget_value(wv) (local_free ((wv)))
122
123 /******************************************************************/
124
125 #ifndef TRUE
126 #define TRUE 1
127 #define FALSE 0
128 #endif /* no TRUE */
129
130 static HMENU current_popup_menu;
131
132 void syms_of_w32menu ();
133 void globals_of_w32menu ();
134
135 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
136 IN HMENU,
137 IN UINT,
138 IN BOOL,
139 IN OUT LPMENUITEMINFOA
140 );
141 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
142 IN HMENU,
143 IN UINT,
144 IN BOOL,
145 IN LPCMENUITEMINFOA
146 );
147
148 GetMenuItemInfoA_Proc get_menu_item_info=NULL;
149 SetMenuItemInfoA_Proc set_menu_item_info=NULL;
150
151 Lisp_Object Vmenu_updating_frame;
152
153 Lisp_Object Qdebug_on_next_call;
154
155 extern Lisp_Object Qmenu_bar;
156
157 extern Lisp_Object QCtoggle, QCradio;
158
159 extern Lisp_Object Voverriding_local_map;
160 extern Lisp_Object Voverriding_local_map_menu_flag;
161
162 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
163
164 extern Lisp_Object Qmenu_bar_update_hook;
165
166 void set_frame_menubar ();
167
168 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
169 Lisp_Object, Lisp_Object, Lisp_Object,
170 Lisp_Object, Lisp_Object));
171 #ifdef HAVE_DIALOGS
172 static Lisp_Object w32_dialog_show ();
173 #endif
174 static Lisp_Object w32_menu_show ();
175
176 static void keymap_panes ();
177 static void single_keymap_panes ();
178 static void single_menu_item ();
179 static void list_of_panes ();
180 static void list_of_items ();
181 void w32_free_menu_strings (HWND);
182 \f
183 /* This holds a Lisp vector that holds the results of decoding
184 the keymaps or alist-of-alists that specify a menu.
185
186 It describes the panes and items within the panes.
187
188 Each pane is described by 3 elements in the vector:
189 t, the pane name, the pane's prefix key.
190 Then follow the pane's items, with 5 elements per item:
191 the item string, the enable flag, the item's value,
192 the definition, and the equivalent keyboard key's description string.
193
194 In some cases, multiple levels of menus may be described.
195 A single vector slot containing nil indicates the start of a submenu.
196 A single vector slot containing lambda indicates the end of a submenu.
197 The submenu follows a menu item which is the way to reach the submenu.
198
199 A single vector slot containing quote indicates that the
200 following items should appear on the right of a dialog box.
201
202 Using a Lisp vector to hold this information while we decode it
203 takes care of protecting all the data from GC. */
204
205 #define MENU_ITEMS_PANE_NAME 1
206 #define MENU_ITEMS_PANE_PREFIX 2
207 #define MENU_ITEMS_PANE_LENGTH 3
208
209 enum menu_item_idx
210 {
211 MENU_ITEMS_ITEM_NAME = 0,
212 MENU_ITEMS_ITEM_ENABLE,
213 MENU_ITEMS_ITEM_VALUE,
214 MENU_ITEMS_ITEM_EQUIV_KEY,
215 MENU_ITEMS_ITEM_DEFINITION,
216 MENU_ITEMS_ITEM_TYPE,
217 MENU_ITEMS_ITEM_SELECTED,
218 MENU_ITEMS_ITEM_HELP,
219 MENU_ITEMS_ITEM_LENGTH
220 };
221
222 static Lisp_Object menu_items;
223
224 /* Number of slots currently allocated in menu_items. */
225 static int menu_items_allocated;
226
227 /* This is the index in menu_items of the first empty slot. */
228 static int menu_items_used;
229
230 /* The number of panes currently recorded in menu_items,
231 excluding those within submenus. */
232 static int menu_items_n_panes;
233
234 /* Current depth within submenus. */
235 static int menu_items_submenu_depth;
236
237 /* Flag which when set indicates a dialog or menu has been posted by
238 Xt on behalf of one of the widget sets. */
239 static int popup_activated_flag;
240
241 static int next_menubar_widget_id;
242
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
246
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249
250 int pending_menu_activation;
251 \f
252
253 /* Return the frame whose ->output_data.w32->menubar_widget equals
254 ID, or 0 if none. */
255
256 static struct frame *
257 menubar_id_to_frame (id)
258 HMENU id;
259 {
260 Lisp_Object tail, frame;
261 FRAME_PTR f;
262
263 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
264 {
265 frame = XCAR (tail);
266 if (!GC_FRAMEP (frame))
267 continue;
268 f = XFRAME (frame);
269 if (!FRAME_WINDOW_P (f))
270 continue;
271 if (f->output_data.w32->menubar_widget == id)
272 return f;
273 }
274 return 0;
275 }
276 \f
277 /* Initialize the menu_items structure if we haven't already done so.
278 Also mark it as currently empty. */
279
280 static void
281 init_menu_items ()
282 {
283 if (NILP (menu_items))
284 {
285 menu_items_allocated = 60;
286 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
287 }
288
289 menu_items_used = 0;
290 menu_items_n_panes = 0;
291 menu_items_submenu_depth = 0;
292 }
293
294 /* Call at the end of generating the data in menu_items.
295 This fills in the number of items in the last pane. */
296
297 static void
298 finish_menu_items ()
299 {
300 }
301
302 /* Call when finished using the data for the current menu
303 in menu_items. */
304
305 static void
306 discard_menu_items ()
307 {
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated > 200)
311 {
312 menu_items = Qnil;
313 menu_items_allocated = 0;
314 }
315 }
316
317 /* Make the menu_items vector twice as large. */
318
319 static void
320 grow_menu_items ()
321 {
322 Lisp_Object old;
323 int old_size = menu_items_allocated;
324 old = menu_items;
325
326 menu_items_allocated *= 2;
327 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
328 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
329 old_size * sizeof (Lisp_Object));
330 }
331
332 /* Begin a submenu. */
333
334 static void
335 push_submenu_start ()
336 {
337 if (menu_items_used + 1 > menu_items_allocated)
338 grow_menu_items ();
339
340 ASET (menu_items, menu_items_used++, Qnil);
341 menu_items_submenu_depth++;
342 }
343
344 /* End a submenu. */
345
346 static void
347 push_submenu_end ()
348 {
349 if (menu_items_used + 1 > menu_items_allocated)
350 grow_menu_items ();
351
352 ASET (menu_items, menu_items_used++, Qlambda);
353 menu_items_submenu_depth--;
354 }
355
356 /* Indicate boundary between left and right. */
357
358 static void
359 push_left_right_boundary ()
360 {
361 if (menu_items_used + 1 > menu_items_allocated)
362 grow_menu_items ();
363
364 ASET (menu_items, menu_items_used++, Qquote);
365 }
366
367 /* Start a new menu pane in menu_items.
368 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
369
370 static void
371 push_menu_pane (name, prefix_vec)
372 Lisp_Object name, prefix_vec;
373 {
374 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
375 grow_menu_items ();
376
377 if (menu_items_submenu_depth == 0)
378 menu_items_n_panes++;
379 ASET (menu_items, menu_items_used++, Qt);
380 ASET (menu_items, menu_items_used++, name);
381 ASET (menu_items, menu_items_used++, prefix_vec);
382 }
383
384 /* Push one menu item into the current pane. NAME is the string to
385 display. ENABLE if non-nil means this item can be selected. KEY
386 is the key generated by choosing this item, or nil if this item
387 doesn't really have a definition. DEF is the definition of this
388 item. EQUIV is the textual description of the keyboard equivalent
389 for this item (or nil if none). TYPE is the type of this menu
390 item, one of nil, `toggle' or `radio'. */
391
392 static void
393 push_menu_item (name, enable, key, def, equiv, type, selected, help)
394 Lisp_Object name, enable, key, def, equiv, type, selected, help;
395 {
396 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
397 grow_menu_items ();
398
399 ASET (menu_items, menu_items_used++, name);
400 ASET (menu_items, menu_items_used++, enable);
401 ASET (menu_items, menu_items_used++, key);
402 ASET (menu_items, menu_items_used++, equiv);
403 ASET (menu_items, menu_items_used++, def);
404 ASET (menu_items, menu_items_used++, type);
405 ASET (menu_items, menu_items_used++, selected);
406 ASET (menu_items, menu_items_used++, help);
407 }
408 \f
409 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
410 and generate menu panes for them in menu_items.
411 If NOTREAL is nonzero,
412 don't bother really computing whether an item is enabled. */
413
414 static void
415 keymap_panes (keymaps, nmaps, notreal)
416 Lisp_Object *keymaps;
417 int nmaps;
418 int notreal;
419 {
420 int mapno;
421
422 init_menu_items ();
423
424 /* Loop over the given keymaps, making a pane for each map.
425 But don't make a pane that is empty--ignore that map instead.
426 P is the number of panes we have made so far. */
427 for (mapno = 0; mapno < nmaps; mapno++)
428 single_keymap_panes (keymaps[mapno],
429 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
430
431 finish_menu_items ();
432 }
433
434 /* This is a recursive subroutine of keymap_panes.
435 It handles one keymap, KEYMAP.
436 The other arguments are passed along
437 or point to local variables of the previous function.
438 If NOTREAL is nonzero, only check for equivalent key bindings, don't
439 evaluate expressions in menu items and don't make any menu.
440
441 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
442
443 static void
444 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
445 Lisp_Object keymap;
446 Lisp_Object pane_name;
447 Lisp_Object prefix;
448 int notreal;
449 int maxdepth;
450 {
451 Lisp_Object pending_maps = Qnil;
452 Lisp_Object tail, item;
453 struct gcpro gcpro1, gcpro2;
454
455 if (maxdepth <= 0)
456 return;
457
458 push_menu_pane (pane_name, prefix);
459
460 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
461 {
462 GCPRO2 (keymap, pending_maps);
463 /* Look at each key binding, and if it is a menu item add it
464 to this menu. */
465 item = XCAR (tail);
466 if (CONSP (item))
467 single_menu_item (XCAR (item), XCDR (item),
468 &pending_maps, notreal, maxdepth);
469 else if (VECTORP (item))
470 {
471 /* Loop over the char values represented in the vector. */
472 int len = ASIZE (item);
473 int c;
474 for (c = 0; c < len; c++)
475 {
476 Lisp_Object character;
477 XSETFASTINT (character, c);
478 single_menu_item (character, AREF (item, c),
479 &pending_maps, notreal, maxdepth);
480 }
481 }
482 UNGCPRO;
483 }
484
485 /* Process now any submenus which want to be panes at this level. */
486 while (!NILP (pending_maps))
487 {
488 Lisp_Object elt, eltcdr, string;
489 elt = Fcar (pending_maps);
490 eltcdr = XCDR (elt);
491 string = XCAR (eltcdr);
492 /* We no longer discard the @ from the beginning of the string here.
493 Instead, we do this in w32_menu_show. */
494 single_keymap_panes (Fcar (elt), string,
495 XCDR (eltcdr), notreal, maxdepth - 1);
496 pending_maps = Fcdr (pending_maps);
497 }
498 }
499 \f
500 /* This is a subroutine of single_keymap_panes that handles one
501 keymap entry.
502 KEY is a key in a keymap and ITEM is its binding.
503 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
504 separate panes.
505 If NOTREAL is nonzero, only check for equivalent key bindings, don't
506 evaluate expressions in menu items and don't make any menu.
507 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
508
509 static void
510 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
511 Lisp_Object key, item;
512 Lisp_Object *pending_maps_ptr;
513 int maxdepth, notreal;
514 {
515 Lisp_Object map, item_string, enabled;
516 struct gcpro gcpro1, gcpro2;
517 int res;
518
519 /* Parse the menu item and leave the result in item_properties. */
520 GCPRO2 (key, item);
521 res = parse_menu_item (item, notreal, 0);
522 UNGCPRO;
523 if (!res)
524 return; /* Not a menu item. */
525
526 map = AREF (item_properties, ITEM_PROPERTY_MAP);
527
528 if (notreal)
529 {
530 /* We don't want to make a menu, just traverse the keymaps to
531 precompute equivalent key bindings. */
532 if (!NILP (map))
533 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
534 return;
535 }
536
537 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
538 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
539
540 if (!NILP (map) && SREF (item_string, 0) == '@')
541 {
542 if (!NILP (enabled))
543 /* An enabled separate pane. Remember this to handle it later. */
544 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
545 *pending_maps_ptr);
546 return;
547 }
548
549 push_menu_item (item_string, enabled, key,
550 AREF (item_properties, ITEM_PROPERTY_DEF),
551 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
552 AREF (item_properties, ITEM_PROPERTY_TYPE),
553 AREF (item_properties, ITEM_PROPERTY_SELECTED),
554 AREF (item_properties, ITEM_PROPERTY_HELP));
555
556 /* Display a submenu using the toolkit. */
557 if (! (NILP (map) || NILP (enabled)))
558 {
559 push_submenu_start ();
560 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
561 push_submenu_end ();
562 }
563 }
564 \f
565 /* Push all the panes and items of a menu described by the
566 alist-of-alists MENU.
567 This handles old-fashioned calls to x-popup-menu. */
568
569 static void
570 list_of_panes (menu)
571 Lisp_Object menu;
572 {
573 Lisp_Object tail;
574
575 init_menu_items ();
576
577 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
578 {
579 Lisp_Object elt, pane_name, pane_data;
580 elt = Fcar (tail);
581 pane_name = Fcar (elt);
582 CHECK_STRING (pane_name);
583 push_menu_pane (pane_name, Qnil);
584 pane_data = Fcdr (elt);
585 CHECK_CONS (pane_data);
586 list_of_items (pane_data);
587 }
588
589 finish_menu_items ();
590 }
591
592 /* Push the items in a single pane defined by the alist PANE. */
593
594 static void
595 list_of_items (pane)
596 Lisp_Object pane;
597 {
598 Lisp_Object tail, item, item1;
599
600 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
601 {
602 item = Fcar (tail);
603 if (STRINGP (item))
604 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
605 else if (NILP (item))
606 push_left_right_boundary ();
607 else
608 {
609 CHECK_CONS (item);
610 item1 = Fcar (item);
611 CHECK_STRING (item1);
612 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
613 }
614 }
615 }
616 \f
617 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
618 doc: /* Pop up a deck-of-cards menu and return user's selection.
619 POSITION is a position specification. This is either a mouse button
620 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
621 are positions in pixels from the top left corner of WINDOW's frame
622 \(WINDOW may be a frame object instead of a window). This controls the
623 position of the center of the first line in the first pane of the
624 menu, not the top left of the menu as a whole. If POSITION is t, it
625 means to use the current mouse position.
626
627 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
628 The menu items come from key bindings that have a menu string as well as
629 a definition; actually, the \"definition\" in such a key binding looks like
630 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
631 the keymap as a top-level element.
632
633 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
634 Otherwise, REAL-DEFINITION should be a valid key binding definition.
635
636 You can also use a list of keymaps as MENU. Then each keymap makes a
637 separate pane. When MENU is a keymap or a list of keymaps, the return
638 value is a list of events.
639
640 Alternatively, you can specify a menu of multiple panes with a list of
641 the form (TITLE PANE1 PANE2...), where each pane is a list of
642 form (TITLE ITEM1 ITEM2...).
643 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
644 appear as an item--that makes a nonselectable line in the menu.
645 With this form of menu, the return value is VALUE from the chosen item.
646
647 If POSITION is nil, don't display the menu at all, just precalculate the
648 cached information about equivalent key sequences. */)
649 (position, menu)
650 Lisp_Object position, menu;
651 {
652 Lisp_Object keymap, tem;
653 int xpos = 0, ypos = 0;
654 Lisp_Object title;
655 char *error_name;
656 Lisp_Object selection;
657 FRAME_PTR f = NULL;
658 Lisp_Object x, y, window;
659 int keymaps = 0;
660 int for_click = 0;
661 struct gcpro gcpro1;
662
663 #ifdef HAVE_MENUS
664 if (! NILP (position))
665 {
666 check_w32 ();
667
668 /* Decode the first argument: find the window and the coordinates. */
669 if (EQ (position, Qt)
670 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
671 || EQ (XCAR (position), Qtool_bar))))
672 {
673 /* Use the mouse's current position. */
674 FRAME_PTR new_f = SELECTED_FRAME ();
675 Lisp_Object bar_window;
676 enum scroll_bar_part part;
677 unsigned long time;
678
679 if (mouse_position_hook)
680 (*mouse_position_hook) (&new_f, 1, &bar_window,
681 &part, &x, &y, &time);
682 if (new_f != 0)
683 XSETFRAME (window, new_f);
684 else
685 {
686 window = selected_window;
687 XSETFASTINT (x, 0);
688 XSETFASTINT (y, 0);
689 }
690 }
691 else
692 {
693 tem = Fcar (position);
694 if (CONSP (tem))
695 {
696 window = Fcar (Fcdr (position));
697 x = Fcar (tem);
698 y = Fcar (Fcdr (tem));
699 }
700 else
701 {
702 for_click = 1;
703 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
704 window = Fcar (tem); /* POSN_WINDOW (tem) */
705 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
706 x = Fcar (tem);
707 y = Fcdr (tem);
708 }
709 }
710
711 CHECK_NUMBER (x);
712 CHECK_NUMBER (y);
713
714 /* Decode where to put the menu. */
715
716 if (FRAMEP (window))
717 {
718 f = XFRAME (window);
719 xpos = 0;
720 ypos = 0;
721 }
722 else if (WINDOWP (window))
723 {
724 CHECK_LIVE_WINDOW (window);
725 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
726
727 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
728 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
729 }
730 else
731 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
732 but I don't want to make one now. */
733 CHECK_WINDOW (window);
734
735 xpos += XINT (x);
736 ypos += XINT (y);
737
738 XSETFRAME (Vmenu_updating_frame, f);
739 }
740 Vmenu_updating_frame = Qnil;
741 #endif /* HAVE_MENUS */
742
743 title = Qnil;
744 GCPRO1 (title);
745
746 /* Decode the menu items from what was specified. */
747
748 keymap = get_keymap (menu, 0, 0);
749 if (CONSP (keymap))
750 {
751 /* We were given a keymap. Extract menu info from the keymap. */
752 Lisp_Object prompt;
753
754 /* Extract the detailed info to make one pane. */
755 keymap_panes (&menu, 1, NILP (position));
756
757 /* Search for a string appearing directly as an element of the keymap.
758 That string is the title of the menu. */
759 prompt = Fkeymap_prompt (keymap);
760 if (NILP (title) && !NILP (prompt))
761 title = prompt;
762
763 /* Make that be the pane title of the first pane. */
764 if (!NILP (prompt) && menu_items_n_panes >= 0)
765 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
766
767 keymaps = 1;
768 }
769 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
770 {
771 /* We were given a list of keymaps. */
772 int nmaps = XFASTINT (Flength (menu));
773 Lisp_Object *maps
774 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
775 int i;
776
777 title = Qnil;
778
779 /* The first keymap that has a prompt string
780 supplies the menu title. */
781 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
782 {
783 Lisp_Object prompt;
784
785 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
786
787 prompt = Fkeymap_prompt (keymap);
788 if (NILP (title) && !NILP (prompt))
789 title = prompt;
790 }
791
792 /* Extract the detailed info to make one pane. */
793 keymap_panes (maps, nmaps, NILP (position));
794
795 /* Make the title be the pane title of the first pane. */
796 if (!NILP (title) && menu_items_n_panes >= 0)
797 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
798
799 keymaps = 1;
800 }
801 else
802 {
803 /* We were given an old-fashioned menu. */
804 title = Fcar (menu);
805 CHECK_STRING (title);
806
807 list_of_panes (Fcdr (menu));
808
809 keymaps = 0;
810 }
811
812 if (NILP (position))
813 {
814 discard_menu_items ();
815 UNGCPRO;
816 return Qnil;
817 }
818
819 #ifdef HAVE_MENUS
820 /* If resources from a previous popup menu exist yet, does nothing
821 until the `menu_free_timer' has freed them (see w32fns.c).
822 */
823 if (current_popup_menu)
824 {
825 discard_menu_items ();
826 UNGCPRO;
827 return Qnil;
828 }
829
830 /* Display them in a menu. */
831 BLOCK_INPUT;
832
833 selection = w32_menu_show (f, xpos, ypos, for_click,
834 keymaps, title, &error_name);
835 UNBLOCK_INPUT;
836
837 discard_menu_items ();
838 #endif /* HAVE_MENUS */
839
840 UNGCPRO;
841
842 if (error_name) error (error_name);
843 return selection;
844 }
845
846 #ifdef HAVE_MENUS
847
848 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
849 doc: /* Pop up a dialog box and return user's selection.
850 POSITION specifies which frame to use.
851 This is normally a mouse button event or a window or frame.
852 If POSITION is t, it means to use the frame the mouse is on.
853 The dialog box appears in the middle of the specified frame.
854
855 CONTENTS specifies the alternatives to display in the dialog box.
856 It is a list of the form (TITLE ITEM1 ITEM2...).
857 Each ITEM is a cons cell (STRING . VALUE).
858 The return value is VALUE from the chosen item.
859
860 An ITEM may also be just a string--that makes a nonselectable item.
861 An ITEM may also be nil--that means to put all preceding items
862 on the left of the dialog box and all following items on the right.
863 \(By default, approximately half appear on each side.) */)
864 (position, contents)
865 Lisp_Object position, contents;
866 {
867 FRAME_PTR f = NULL;
868 Lisp_Object window;
869
870 check_w32 ();
871
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position, Qt)
874 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
875 || EQ (XCAR (position), Qtool_bar))))
876 {
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f = SELECTED_FRAME ();
880 Lisp_Object bar_window;
881 enum scroll_bar_part part;
882 unsigned long time;
883 Lisp_Object x, y;
884
885 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
886
887 if (new_f != 0)
888 XSETFRAME (window, new_f);
889 else
890 window = selected_window;
891 #endif
892 window = selected_window;
893 }
894 else if (CONSP (position))
895 {
896 Lisp_Object tem;
897 tem = Fcar (position);
898 if (CONSP (tem))
899 window = Fcar (Fcdr (position));
900 else
901 {
902 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
903 window = Fcar (tem); /* POSN_WINDOW (tem) */
904 }
905 }
906 else if (WINDOWP (position) || FRAMEP (position))
907 window = position;
908 else
909 window = Qnil;
910
911 /* Decode where to put the menu. */
912
913 if (FRAMEP (window))
914 f = XFRAME (window);
915 else if (WINDOWP (window))
916 {
917 CHECK_LIVE_WINDOW (window);
918 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
919 }
920 else
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window);
924
925 #ifndef HAVE_DIALOGS
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
928 {
929 Lisp_Object x, y, frame, newpos;
930 XSETFRAME (frame, f);
931 XSETINT (x, x_pixel_width (f) / 2);
932 XSETINT (y, x_pixel_height (f) / 2);
933 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
934
935 return Fx_popup_menu (newpos,
936 Fcons (Fcar (contents), Fcons (contents, Qnil)));
937 }
938 #else /* HAVE_DIALOGS */
939 {
940 Lisp_Object title;
941 char *error_name;
942 Lisp_Object selection;
943
944 /* Decode the dialog items from what was specified. */
945 title = Fcar (contents);
946 CHECK_STRING (title);
947
948 list_of_panes (Fcons (contents, Qnil));
949
950 /* Display them in a dialog box. */
951 BLOCK_INPUT;
952 selection = w32_dialog_show (f, 0, title, &error_name);
953 UNBLOCK_INPUT;
954
955 discard_menu_items ();
956
957 if (error_name) error (error_name);
958 return selection;
959 }
960 #endif /* HAVE_DIALOGS */
961 }
962
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
966
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
970
971 But first we recompute the menu bar contents (the whole tree).
972
973 This way we can safely execute Lisp code. */
974
975 void
976 x_activate_menubar (f)
977 FRAME_PTR f;
978 {
979 set_frame_menubar (f, 0, 1);
980
981 /* Lock out further menubar changes while active. */
982 f->output_data.w32->menubar_active = 1;
983
984 /* Signal input thread to return from WM_INITMENU. */
985 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
986 }
987
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
992
993 void
994 menubar_selection_callback (FRAME_PTR f, void * client_data)
995 {
996 Lisp_Object prefix, entry;
997 Lisp_Object vector;
998 Lisp_Object *subprefix_stack;
999 int submenu_depth = 0;
1000 int i;
1001
1002 if (!f)
1003 return;
1004 entry = Qnil;
1005 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1006 vector = f->menu_bar_vector;
1007 prefix = Qnil;
1008 i = 0;
1009 while (i < f->menu_bar_items_used)
1010 {
1011 if (EQ (AREF (vector, i), Qnil))
1012 {
1013 subprefix_stack[submenu_depth++] = prefix;
1014 prefix = entry;
1015 i++;
1016 }
1017 else if (EQ (AREF (vector, i), Qlambda))
1018 {
1019 prefix = subprefix_stack[--submenu_depth];
1020 i++;
1021 }
1022 else if (EQ (AREF (vector, i), Qt))
1023 {
1024 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1025 i += MENU_ITEMS_PANE_LENGTH;
1026 }
1027 else
1028 {
1029 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT) client_data == i)
1033 {
1034 int j;
1035 struct input_event buf;
1036 Lisp_Object frame;
1037 EVENT_INIT (buf);
1038
1039 XSETFRAME (frame, f);
1040 buf.kind = MENU_BAR_EVENT;
1041 buf.frame_or_window = frame;
1042 buf.arg = frame;
1043 kbd_buffer_store_event (&buf);
1044
1045 for (j = 0; j < submenu_depth; j++)
1046 if (!NILP (subprefix_stack[j]))
1047 {
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = subprefix_stack[j];
1051 kbd_buffer_store_event (&buf);
1052 }
1053
1054 if (!NILP (prefix))
1055 {
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = prefix;
1059 kbd_buffer_store_event (&buf);
1060 }
1061
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = entry;
1065 kbd_buffer_store_event (&buf);
1066
1067 /* Free memory used by owner-drawn and help-echo strings. */
1068 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1069 f->output_data.w32->menu_command_in_progress = 0;
1070 f->output_data.w32->menubar_active = 0;
1071 return;
1072 }
1073 i += MENU_ITEMS_ITEM_LENGTH;
1074 }
1075 }
1076 /* Free memory used by owner-drawn and help-echo strings. */
1077 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1078 f->output_data.w32->menu_command_in_progress = 0;
1079 f->output_data.w32->menubar_active = 0;
1080 }
1081
1082 /* Allocate a widget_value, blocking input. */
1083
1084 widget_value *
1085 xmalloc_widget_value ()
1086 {
1087 widget_value *value;
1088
1089 BLOCK_INPUT;
1090 value = malloc_widget_value ();
1091 UNBLOCK_INPUT;
1092
1093 return value;
1094 }
1095
1096 /* This recursively calls free_widget_value on the tree of widgets.
1097 It must free all data that was malloc'ed for these widget_values.
1098 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1099 must be left alone. */
1100
1101 void
1102 free_menubar_widget_value_tree (wv)
1103 widget_value *wv;
1104 {
1105 if (! wv) return;
1106
1107 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1108
1109 if (wv->contents && (wv->contents != (widget_value*)1))
1110 {
1111 free_menubar_widget_value_tree (wv->contents);
1112 wv->contents = (widget_value *) 0xDEADBEEF;
1113 }
1114 if (wv->next)
1115 {
1116 free_menubar_widget_value_tree (wv->next);
1117 wv->next = (widget_value *) 0xDEADBEEF;
1118 }
1119 BLOCK_INPUT;
1120 free_widget_value (wv);
1121 UNBLOCK_INPUT;
1122 }
1123 \f
1124 /* Set up data i menu_items for a menu bar item
1125 whose event type is ITEM_KEY (with string ITEM_NAME)
1126 and whose contents come from the list of keymaps MAPS. */
1127
1128 static int
1129 parse_single_submenu (item_key, item_name, maps)
1130 Lisp_Object item_key, item_name, maps;
1131 {
1132 Lisp_Object length;
1133 int len;
1134 Lisp_Object *mapvec;
1135 int i;
1136 int top_level_items = 0;
1137
1138 length = Flength (maps);
1139 len = XINT (length);
1140
1141 /* Convert the list MAPS into a vector MAPVEC. */
1142 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1143 for (i = 0; i < len; i++)
1144 {
1145 mapvec[i] = Fcar (maps);
1146 maps = Fcdr (maps);
1147 }
1148
1149 /* Loop over the given keymaps, making a pane for each map.
1150 But don't make a pane that is empty--ignore that map instead. */
1151 for (i = 0; i < len; i++)
1152 {
1153 if (SYMBOLP (mapvec[i])
1154 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1155 {
1156 /* Here we have a command at top level in the menu bar
1157 as opposed to a submenu. */
1158 top_level_items = 1;
1159 push_menu_pane (Qnil, Qnil);
1160 push_menu_item (item_name, Qt, item_key, mapvec[i],
1161 Qnil, Qnil, Qnil, Qnil);
1162 }
1163 else
1164 {
1165 Lisp_Object prompt;
1166 prompt = Fkeymap_prompt (mapvec[i]);
1167 single_keymap_panes (mapvec[i],
1168 !NILP (prompt) ? prompt : item_name,
1169 item_key, 0, 10);
1170 }
1171 }
1172
1173 return top_level_items;
1174 }
1175
1176
1177 /* Create a tree of widget_value objects
1178 representing the panes and items
1179 in menu_items starting at index START, up to index END. */
1180
1181 static widget_value *
1182 digest_single_submenu (start, end, top_level_items)
1183 int start, end, top_level_items;
1184 {
1185 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1186 int i;
1187 int submenu_depth = 0;
1188 widget_value **submenu_stack;
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 wv->button_type = BUTTON_TYPE_NONE;
1197 wv->help = Qnil;
1198 first_wv = wv;
1199 save_wv = 0;
1200 prev_wv = 0;
1201
1202 /* Loop over all panes and items made by the preceding call
1203 to parse_single_submenu and construct a tree of widget_value objects.
1204 Ignore the panes and items used by previous calls to
1205 digest_single_submenu, even though those are also in menu_items. */
1206 i = start;
1207 while (i < end)
1208 {
1209 if (EQ (AREF (menu_items, i), Qnil))
1210 {
1211 submenu_stack[submenu_depth++] = save_wv;
1212 save_wv = prev_wv;
1213 prev_wv = 0;
1214 i++;
1215 }
1216 else if (EQ (AREF (menu_items, i), Qlambda))
1217 {
1218 prev_wv = save_wv;
1219 save_wv = submenu_stack[--submenu_depth];
1220 i++;
1221 }
1222 else if (EQ (AREF (menu_items, i), Qt)
1223 && submenu_depth != 0)
1224 i += MENU_ITEMS_PANE_LENGTH;
1225 /* Ignore a nil in the item list.
1226 It's meaningful only for dialog boxes. */
1227 else if (EQ (AREF (menu_items, i), Qquote))
1228 i += 1;
1229 else if (EQ (AREF (menu_items, i), Qt))
1230 {
1231 /* Create a new pane. */
1232 Lisp_Object pane_name, prefix;
1233 char *pane_string;
1234
1235 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1236 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1237
1238 #ifndef HAVE_MULTILINGUAL_MENU
1239 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1240 {
1241 pane_name = ENCODE_SYSTEM (pane_name);
1242 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1243 }
1244 #endif
1245 pane_string = (NILP (pane_name)
1246 ? "" : (char *) SDATA (pane_name));
1247 /* If there is just one top-level pane, put all its items directly
1248 under the top-level menu. */
1249 if (menu_items_n_panes == 1)
1250 pane_string = "";
1251
1252 /* If the pane has a meaningful name,
1253 make the pane a top-level menu item
1254 with its items as a submenu beneath it. */
1255 if (strcmp (pane_string, ""))
1256 {
1257 wv = xmalloc_widget_value ();
1258 if (save_wv)
1259 save_wv->next = wv;
1260 else
1261 first_wv->contents = wv;
1262 wv->name = pane_string;
1263 /* Ignore the @ that means "separate pane".
1264 This is a kludge, but this isn't worth more time. */
1265 if (!NILP (prefix) && wv->name[0] == '@')
1266 wv->name++;
1267 wv->value = 0;
1268 wv->enabled = 1;
1269 wv->button_type = BUTTON_TYPE_NONE;
1270 wv->help = Qnil;
1271 }
1272 save_wv = wv;
1273 prev_wv = 0;
1274 i += MENU_ITEMS_PANE_LENGTH;
1275 }
1276 else
1277 {
1278 /* Create a new item within current pane. */
1279 Lisp_Object item_name, enable, descrip, def, type, selected;
1280 Lisp_Object help;
1281
1282 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1283 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1284 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1285 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1286 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1287 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1288 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1289
1290 #ifndef HAVE_MULTILINGUAL_MENU
1291 if (STRING_MULTIBYTE (item_name))
1292 {
1293 item_name = ENCODE_SYSTEM (item_name);
1294 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1295 }
1296
1297 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1298 {
1299 descrip = ENCODE_SYSTEM (descrip);
1300 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1301 }
1302 #endif /* not HAVE_MULTILINGUAL_MENU */
1303
1304 wv = xmalloc_widget_value ();
1305 if (prev_wv)
1306 prev_wv->next = wv;
1307 else
1308 save_wv->contents = wv;
1309
1310 wv->name = (char *) SDATA (item_name);
1311 if (!NILP (descrip))
1312 wv->key = (char *) SDATA (descrip);
1313 wv->value = 0;
1314 /* The EMACS_INT cast avoids a warning. There's no problem
1315 as long as pointers have enough bits to hold small integers. */
1316 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1317 wv->enabled = !NILP (enable);
1318
1319 if (NILP (type))
1320 wv->button_type = BUTTON_TYPE_NONE;
1321 else if (EQ (type, QCradio))
1322 wv->button_type = BUTTON_TYPE_RADIO;
1323 else if (EQ (type, QCtoggle))
1324 wv->button_type = BUTTON_TYPE_TOGGLE;
1325 else
1326 abort ();
1327
1328 wv->selected = !NILP (selected);
1329 if (!STRINGP (help))
1330 help = Qnil;
1331
1332 wv->help = help;
1333
1334 prev_wv = wv;
1335
1336 i += MENU_ITEMS_ITEM_LENGTH;
1337 }
1338 }
1339
1340 /* If we have just one "menu item"
1341 that was originally a button, return it by itself. */
1342 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1343 {
1344 wv = first_wv->contents;
1345 free_widget_value (first_wv);
1346 return wv;
1347 }
1348
1349 return first_wv;
1350 }
1351 \f
1352 /* Set the contents of the menubar widgets of frame F.
1353 The argument FIRST_TIME is currently ignored;
1354 it is set the first time this is called, from initialize_frame_menubar. */
1355
1356 void
1357 set_frame_menubar (f, first_time, deep_p)
1358 FRAME_PTR f;
1359 int first_time;
1360 int deep_p;
1361 {
1362 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1363 Lisp_Object items;
1364 widget_value *wv, *first_wv, *prev_wv = 0;
1365 int i, last_i;
1366 int *submenu_start, *submenu_end;
1367 int *submenu_top_level_items, *submenu_n_panes;
1368
1369 /* We must not change the menubar when actually in use. */
1370 if (f->output_data.w32->menubar_active)
1371 return;
1372
1373 XSETFRAME (Vmenu_updating_frame, f);
1374
1375 if (! menubar_widget)
1376 deep_p = 1;
1377 else if (pending_menu_activation && !deep_p)
1378 deep_p = 1;
1379
1380 if (deep_p)
1381 {
1382 /* Make a widget-value tree representing the entire menu trees. */
1383
1384 struct buffer *prev = current_buffer;
1385 Lisp_Object buffer;
1386 int specpdl_count = SPECPDL_INDEX ();
1387 int previous_menu_items_used = f->menu_bar_items_used;
1388 Lisp_Object *previous_items
1389 = (Lisp_Object *) alloca (previous_menu_items_used
1390 * sizeof (Lisp_Object));
1391
1392 /* If we are making a new widget, its contents are empty,
1393 do always reinitialize them. */
1394 if (! menubar_widget)
1395 previous_menu_items_used = 0;
1396
1397 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1398 specbind (Qinhibit_quit, Qt);
1399 /* Don't let the debugger step into this code
1400 because it is not reentrant. */
1401 specbind (Qdebug_on_next_call, Qnil);
1402
1403 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1404 if (NILP (Voverriding_local_map_menu_flag))
1405 {
1406 specbind (Qoverriding_terminal_local_map, Qnil);
1407 specbind (Qoverriding_local_map, Qnil);
1408 }
1409
1410 set_buffer_internal_1 (XBUFFER (buffer));
1411
1412 /* Run the Lucid hook. */
1413 safe_run_hooks (Qactivate_menubar_hook);
1414 /* If it has changed current-menubar from previous value,
1415 really recompute the menubar from the value. */
1416 if (! NILP (Vlucid_menu_bar_dirty_flag))
1417 call0 (Qrecompute_lucid_menubar);
1418 safe_run_hooks (Qmenu_bar_update_hook);
1419 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1420
1421 items = FRAME_MENU_BAR_ITEMS (f);
1422
1423 /* Save the frame's previous menu bar contents data. */
1424 if (previous_menu_items_used)
1425 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1426 previous_menu_items_used * sizeof (Lisp_Object));
1427
1428 /* Fill in menu_items with the current menu bar contents.
1429 This can evaluate Lisp code. */
1430 menu_items = f->menu_bar_vector;
1431 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1432 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1433 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1434 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1435 submenu_top_level_items
1436 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1437 init_menu_items ();
1438 for (i = 0; i < ASIZE (items); i += 4)
1439 {
1440 Lisp_Object key, string, maps;
1441
1442 last_i = i;
1443
1444 key = AREF (items, i);
1445 string = AREF (items, i + 1);
1446 maps = AREF (items, i + 2);
1447 if (NILP (string))
1448 break;
1449
1450 submenu_start[i] = menu_items_used;
1451
1452 menu_items_n_panes = 0;
1453 submenu_top_level_items[i]
1454 = parse_single_submenu (key, string, maps);
1455 submenu_n_panes[i] = menu_items_n_panes;
1456
1457 submenu_end[i] = menu_items_used;
1458 }
1459
1460 finish_menu_items ();
1461
1462 /* Convert menu_items into widget_value trees
1463 to display the menu. This cannot evaluate Lisp code. */
1464
1465 wv = xmalloc_widget_value ();
1466 wv->name = "menubar";
1467 wv->value = 0;
1468 wv->enabled = 1;
1469 wv->button_type = BUTTON_TYPE_NONE;
1470 wv->help = Qnil;
1471 first_wv = wv;
1472
1473 for (i = 0; i < last_i; i += 4)
1474 {
1475 menu_items_n_panes = submenu_n_panes[i];
1476 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1477 submenu_top_level_items[i]);
1478 if (prev_wv)
1479 prev_wv->next = wv;
1480 else
1481 first_wv->contents = wv;
1482 /* Don't set wv->name here; GC during the loop might relocate it. */
1483 wv->enabled = 1;
1484 wv->button_type = BUTTON_TYPE_NONE;
1485 prev_wv = wv;
1486 }
1487
1488 set_buffer_internal_1 (prev);
1489 unbind_to (specpdl_count, Qnil);
1490
1491 /* If there has been no change in the Lisp-level contents
1492 of the menu bar, skip redisplaying it. Just exit. */
1493
1494 for (i = 0; i < previous_menu_items_used; i++)
1495 if (menu_items_used == i
1496 || (!EQ (previous_items[i], AREF (menu_items, i))))
1497 break;
1498 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1499 {
1500 free_menubar_widget_value_tree (first_wv);
1501 menu_items = Qnil;
1502
1503 return;
1504 }
1505
1506 /* Now GC cannot happen during the lifetime of the widget_value,
1507 so it's safe to store data from a Lisp_String, as long as
1508 local copies are made when the actual menu is created.
1509 Windows takes care of this for normal string items, but
1510 not for owner-drawn items or additional item-info. */
1511 wv = first_wv->contents;
1512 for (i = 0; i < ASIZE (items); i += 4)
1513 {
1514 Lisp_Object string;
1515 string = AREF (items, i + 1);
1516 if (NILP (string))
1517 break;
1518 wv->name = (char *) SDATA (string);
1519 wv = wv->next;
1520 }
1521
1522 f->menu_bar_vector = menu_items;
1523 f->menu_bar_items_used = menu_items_used;
1524 menu_items = Qnil;
1525 }
1526 else
1527 {
1528 /* Make a widget-value tree containing
1529 just the top level menu bar strings. */
1530
1531 wv = xmalloc_widget_value ();
1532 wv->name = "menubar";
1533 wv->value = 0;
1534 wv->enabled = 1;
1535 wv->button_type = BUTTON_TYPE_NONE;
1536 wv->help = Qnil;
1537 first_wv = wv;
1538
1539 items = FRAME_MENU_BAR_ITEMS (f);
1540 for (i = 0; i < ASIZE (items); i += 4)
1541 {
1542 Lisp_Object string;
1543
1544 string = AREF (items, i + 1);
1545 if (NILP (string))
1546 break;
1547
1548 wv = xmalloc_widget_value ();
1549 wv->name = (char *) SDATA (string);
1550 wv->value = 0;
1551 wv->enabled = 1;
1552 wv->button_type = BUTTON_TYPE_NONE;
1553 wv->help = Qnil;
1554 /* This prevents lwlib from assuming this
1555 menu item is really supposed to be empty. */
1556 /* The EMACS_INT cast avoids a warning.
1557 This value just has to be different from small integers. */
1558 wv->call_data = (void *) (EMACS_INT) (-1);
1559
1560 if (prev_wv)
1561 prev_wv->next = wv;
1562 else
1563 first_wv->contents = wv;
1564 prev_wv = wv;
1565 }
1566
1567 /* Forget what we thought we knew about what is in the
1568 detailed contents of the menu bar menus.
1569 Changing the top level always destroys the contents. */
1570 f->menu_bar_items_used = 0;
1571 }
1572
1573 /* Create or update the menu bar widget. */
1574
1575 BLOCK_INPUT;
1576
1577 if (menubar_widget)
1578 {
1579 /* Empty current menubar, rather than creating a fresh one. */
1580 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1581 ;
1582 }
1583 else
1584 {
1585 menubar_widget = CreateMenu ();
1586 }
1587 fill_in_menu (menubar_widget, first_wv->contents);
1588
1589 free_menubar_widget_value_tree (first_wv);
1590
1591 {
1592 HMENU old_widget = f->output_data.w32->menubar_widget;
1593
1594 f->output_data.w32->menubar_widget = menubar_widget;
1595 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1596 /* Causes flicker when menu bar is updated
1597 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1598
1599 /* Force the window size to be recomputed so that the frame's text
1600 area remains the same, if menubar has just been created. */
1601 if (old_widget == NULL)
1602 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1603 }
1604
1605 UNBLOCK_INPUT;
1606 }
1607
1608 /* Called from Fx_create_frame to create the initial menubar of a frame
1609 before it is mapped, so that the window is mapped with the menubar already
1610 there instead of us tacking it on later and thrashing the window after it
1611 is visible. */
1612
1613 void
1614 initialize_frame_menubar (f)
1615 FRAME_PTR f;
1616 {
1617 /* This function is called before the first chance to redisplay
1618 the frame. It has to be, so the frame will have the right size. */
1619 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1620 set_frame_menubar (f, 1, 1);
1621 }
1622
1623 /* Get rid of the menu bar of frame F, and free its storage.
1624 This is used when deleting a frame, and when turning off the menu bar. */
1625
1626 void
1627 free_frame_menubar (f)
1628 FRAME_PTR f;
1629 {
1630 BLOCK_INPUT;
1631
1632 {
1633 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1634 SetMenu (FRAME_W32_WINDOW (f), NULL);
1635 f->output_data.w32->menubar_widget = NULL;
1636 DestroyMenu (old);
1637 }
1638
1639 UNBLOCK_INPUT;
1640 }
1641
1642 \f
1643 /* w32_menu_show actually displays a menu using the panes and items in
1644 menu_items and returns the value selected from it; we assume input
1645 is blocked by the caller. */
1646
1647 /* F is the frame the menu is for.
1648 X and Y are the frame-relative specified position,
1649 relative to the inside upper left corner of the frame F.
1650 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1651 KEYMAPS is 1 if this menu was specified with keymaps;
1652 in that case, we return a list containing the chosen item's value
1653 and perhaps also the pane's prefix.
1654 TITLE is the specified menu title.
1655 ERROR is a place to store an error message string in case of failure.
1656 (We return nil on failure, but the value doesn't actually matter.) */
1657
1658 static Lisp_Object
1659 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1660 FRAME_PTR f;
1661 int x;
1662 int y;
1663 int for_click;
1664 int keymaps;
1665 Lisp_Object title;
1666 char **error;
1667 {
1668 int i;
1669 int menu_item_selection;
1670 HMENU menu;
1671 POINT pos;
1672 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1673 widget_value **submenu_stack
1674 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1675 Lisp_Object *subprefix_stack
1676 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1677 int submenu_depth = 0;
1678 int first_pane;
1679
1680 *error = NULL;
1681
1682 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1683 {
1684 *error = "Empty menu";
1685 return Qnil;
1686 }
1687
1688 /* Create a tree of widget_value objects
1689 representing the panes and their items. */
1690 wv = xmalloc_widget_value ();
1691 wv->name = "menu";
1692 wv->value = 0;
1693 wv->enabled = 1;
1694 wv->button_type = BUTTON_TYPE_NONE;
1695 wv->help = Qnil;
1696 first_wv = wv;
1697 first_pane = 1;
1698
1699 /* Loop over all panes and items, filling in the tree. */
1700 i = 0;
1701 while (i < menu_items_used)
1702 {
1703 if (EQ (AREF (menu_items, i), Qnil))
1704 {
1705 submenu_stack[submenu_depth++] = save_wv;
1706 save_wv = prev_wv;
1707 prev_wv = 0;
1708 first_pane = 1;
1709 i++;
1710 }
1711 else if (EQ (AREF (menu_items, i), Qlambda))
1712 {
1713 prev_wv = save_wv;
1714 save_wv = submenu_stack[--submenu_depth];
1715 first_pane = 0;
1716 i++;
1717 }
1718 else if (EQ (AREF (menu_items, i), Qt)
1719 && submenu_depth != 0)
1720 i += MENU_ITEMS_PANE_LENGTH;
1721 /* Ignore a nil in the item list.
1722 It's meaningful only for dialog boxes. */
1723 else if (EQ (AREF (menu_items, i), Qquote))
1724 i += 1;
1725 else if (EQ (AREF (menu_items, i), Qt))
1726 {
1727 /* Create a new pane. */
1728 Lisp_Object pane_name, prefix;
1729 char *pane_string;
1730 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1731 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1732 #ifndef HAVE_MULTILINGUAL_MENU
1733 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1734 {
1735 pane_name = ENCODE_SYSTEM (pane_name);
1736 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1737 }
1738 #endif
1739 pane_string = (NILP (pane_name)
1740 ? "" : (char *) SDATA (pane_name));
1741 /* If there is just one top-level pane, put all its items directly
1742 under the top-level menu. */
1743 if (menu_items_n_panes == 1)
1744 pane_string = "";
1745
1746 /* If the pane has a meaningful name,
1747 make the pane a top-level menu item
1748 with its items as a submenu beneath it. */
1749 if (!keymaps && strcmp (pane_string, ""))
1750 {
1751 wv = xmalloc_widget_value ();
1752 if (save_wv)
1753 save_wv->next = wv;
1754 else
1755 first_wv->contents = wv;
1756 wv->name = pane_string;
1757 if (keymaps && !NILP (prefix))
1758 wv->name++;
1759 wv->value = 0;
1760 wv->enabled = 1;
1761 wv->button_type = BUTTON_TYPE_NONE;
1762 wv->help = Qnil;
1763 save_wv = wv;
1764 prev_wv = 0;
1765 }
1766 else if (first_pane)
1767 {
1768 save_wv = wv;
1769 prev_wv = 0;
1770 }
1771 first_pane = 0;
1772 i += MENU_ITEMS_PANE_LENGTH;
1773 }
1774 else
1775 {
1776 /* Create a new item within current pane. */
1777 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1778
1779 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1780 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1781 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1782 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1783 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1784 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1785 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1786
1787 #ifndef HAVE_MULTILINGUAL_MENU
1788 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1789 {
1790 item_name = ENCODE_SYSTEM (item_name);
1791 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1792 }
1793 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1794 {
1795 descrip = ENCODE_SYSTEM (descrip);
1796 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1797 }
1798 #endif /* not HAVE_MULTILINGUAL_MENU */
1799
1800 wv = xmalloc_widget_value ();
1801 if (prev_wv)
1802 prev_wv->next = wv;
1803 else
1804 save_wv->contents = wv;
1805 wv->name = (char *) SDATA (item_name);
1806 if (!NILP (descrip))
1807 wv->key = (char *) SDATA (descrip);
1808 wv->value = 0;
1809 /* Use the contents index as call_data, since we are
1810 restricted to 16-bits. */
1811 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1812 wv->enabled = !NILP (enable);
1813
1814 if (NILP (type))
1815 wv->button_type = BUTTON_TYPE_NONE;
1816 else if (EQ (type, QCtoggle))
1817 wv->button_type = BUTTON_TYPE_TOGGLE;
1818 else if (EQ (type, QCradio))
1819 wv->button_type = BUTTON_TYPE_RADIO;
1820 else
1821 abort ();
1822
1823 wv->selected = !NILP (selected);
1824 if (!STRINGP (help))
1825 help = Qnil;
1826
1827 wv->help = help;
1828
1829 prev_wv = wv;
1830
1831 i += MENU_ITEMS_ITEM_LENGTH;
1832 }
1833 }
1834
1835 /* Deal with the title, if it is non-nil. */
1836 if (!NILP (title))
1837 {
1838 widget_value *wv_title = xmalloc_widget_value ();
1839 widget_value *wv_sep = xmalloc_widget_value ();
1840
1841 /* Maybe replace this separator with a bitmap or owner-draw item
1842 so that it looks better. Having two separators looks odd. */
1843 wv_sep->name = "--";
1844 wv_sep->next = first_wv->contents;
1845 wv_sep->help = Qnil;
1846
1847 #ifndef HAVE_MULTILINGUAL_MENU
1848 if (STRING_MULTIBYTE (title))
1849 title = ENCODE_SYSTEM (title);
1850 #endif
1851 wv_title->name = (char *) SDATA (title);
1852 wv_title->enabled = TRUE;
1853 wv_title->title = TRUE;
1854 wv_title->button_type = BUTTON_TYPE_NONE;
1855 wv_title->help = Qnil;
1856 wv_title->next = wv_sep;
1857 first_wv->contents = wv_title;
1858 }
1859
1860 /* Actually create the menu. */
1861 current_popup_menu = menu = CreatePopupMenu ();
1862 fill_in_menu (menu, first_wv->contents);
1863
1864 /* Adjust coordinates to be root-window-relative. */
1865 pos.x = x;
1866 pos.y = y;
1867 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1868
1869 /* No selection has been chosen yet. */
1870 menu_item_selection = 0;
1871
1872 /* Display the menu. */
1873 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1874 WM_EMACS_TRACKPOPUPMENU,
1875 (WPARAM)menu, (LPARAM)&pos);
1876
1877 /* Clean up extraneous mouse events which might have been generated
1878 during the call. */
1879 discard_mouse_events ();
1880
1881 /* Free the widget_value objects we used to specify the contents. */
1882 free_menubar_widget_value_tree (first_wv);
1883
1884 DestroyMenu (menu);
1885
1886 /* Find the selected item, and its pane, to return
1887 the proper value. */
1888 if (menu_item_selection != 0)
1889 {
1890 Lisp_Object prefix, entry;
1891
1892 prefix = entry = Qnil;
1893 i = 0;
1894 while (i < menu_items_used)
1895 {
1896 if (EQ (AREF (menu_items, i), Qnil))
1897 {
1898 subprefix_stack[submenu_depth++] = prefix;
1899 prefix = entry;
1900 i++;
1901 }
1902 else if (EQ (AREF (menu_items, i), Qlambda))
1903 {
1904 prefix = subprefix_stack[--submenu_depth];
1905 i++;
1906 }
1907 else if (EQ (AREF (menu_items, i), Qt))
1908 {
1909 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1910 i += MENU_ITEMS_PANE_LENGTH;
1911 }
1912 /* Ignore a nil in the item list.
1913 It's meaningful only for dialog boxes. */
1914 else if (EQ (AREF (menu_items, i), Qquote))
1915 i += 1;
1916 else
1917 {
1918 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1919 if (menu_item_selection == i)
1920 {
1921 if (keymaps != 0)
1922 {
1923 int j;
1924
1925 entry = Fcons (entry, Qnil);
1926 if (!NILP (prefix))
1927 entry = Fcons (prefix, entry);
1928 for (j = submenu_depth - 1; j >= 0; j--)
1929 if (!NILP (subprefix_stack[j]))
1930 entry = Fcons (subprefix_stack[j], entry);
1931 }
1932 return entry;
1933 }
1934 i += MENU_ITEMS_ITEM_LENGTH;
1935 }
1936 }
1937 }
1938
1939 return Qnil;
1940 }
1941 \f
1942
1943 #ifdef HAVE_DIALOGS
1944 static char * button_names [] = {
1945 "button1", "button2", "button3", "button4", "button5",
1946 "button6", "button7", "button8", "button9", "button10" };
1947
1948 static Lisp_Object
1949 w32_dialog_show (f, keymaps, title, error)
1950 FRAME_PTR f;
1951 int keymaps;
1952 Lisp_Object title;
1953 char **error;
1954 {
1955 int i, nb_buttons=0;
1956 char dialog_name[6];
1957 int menu_item_selection;
1958
1959 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1960
1961 /* Number of elements seen so far, before boundary. */
1962 int left_count = 0;
1963 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1964 int boundary_seen = 0;
1965
1966 *error = NULL;
1967
1968 if (menu_items_n_panes > 1)
1969 {
1970 *error = "Multiple panes in dialog box";
1971 return Qnil;
1972 }
1973
1974 /* Create a tree of widget_value objects
1975 representing the text label and buttons. */
1976 {
1977 Lisp_Object pane_name, prefix;
1978 char *pane_string;
1979 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
1980 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
1981 pane_string = (NILP (pane_name)
1982 ? "" : (char *) SDATA (pane_name));
1983 prev_wv = xmalloc_widget_value ();
1984 prev_wv->value = pane_string;
1985 if (keymaps && !NILP (prefix))
1986 prev_wv->name++;
1987 prev_wv->enabled = 1;
1988 prev_wv->name = "message";
1989 prev_wv->help = Qnil;
1990 first_wv = prev_wv;
1991
1992 /* Loop over all panes and items, filling in the tree. */
1993 i = MENU_ITEMS_PANE_LENGTH;
1994 while (i < menu_items_used)
1995 {
1996
1997 /* Create a new item within current pane. */
1998 Lisp_Object item_name, enable, descrip, help;
1999
2000 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2001 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2002 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2003 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2004
2005 if (NILP (item_name))
2006 {
2007 free_menubar_widget_value_tree (first_wv);
2008 *error = "Submenu in dialog items";
2009 return Qnil;
2010 }
2011 if (EQ (item_name, Qquote))
2012 {
2013 /* This is the boundary between left-side elts
2014 and right-side elts. Stop incrementing right_count. */
2015 boundary_seen = 1;
2016 i++;
2017 continue;
2018 }
2019 if (nb_buttons >= 9)
2020 {
2021 free_menubar_widget_value_tree (first_wv);
2022 *error = "Too many dialog items";
2023 return Qnil;
2024 }
2025
2026 wv = xmalloc_widget_value ();
2027 prev_wv->next = wv;
2028 wv->name = (char *) button_names[nb_buttons];
2029 if (!NILP (descrip))
2030 wv->key = (char *) SDATA (descrip);
2031 wv->value = (char *) SDATA (item_name);
2032 wv->call_data = (void *) &AREF (menu_items, i);
2033 wv->enabled = !NILP (enable);
2034 wv->help = Qnil;
2035 prev_wv = wv;
2036
2037 if (! boundary_seen)
2038 left_count++;
2039
2040 nb_buttons++;
2041 i += MENU_ITEMS_ITEM_LENGTH;
2042 }
2043
2044 /* If the boundary was not specified,
2045 by default put half on the left and half on the right. */
2046 if (! boundary_seen)
2047 left_count = nb_buttons - nb_buttons / 2;
2048
2049 wv = xmalloc_widget_value ();
2050 wv->name = dialog_name;
2051 wv->help = Qnil;
2052
2053 /* Dialog boxes use a really stupid name encoding
2054 which specifies how many buttons to use
2055 and how many buttons are on the right.
2056 The Q means something also. */
2057 dialog_name[0] = 'Q';
2058 dialog_name[1] = '0' + nb_buttons;
2059 dialog_name[2] = 'B';
2060 dialog_name[3] = 'R';
2061 /* Number of buttons to put on the right. */
2062 dialog_name[4] = '0' + nb_buttons - left_count;
2063 dialog_name[5] = 0;
2064 wv->contents = first_wv;
2065 first_wv = wv;
2066 }
2067
2068 /* Actually create the dialog. */
2069 dialog_id = widget_id_tick++;
2070 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2071 f->output_data.w32->widget, 1, 0,
2072 dialog_selection_callback, 0);
2073 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2074
2075 /* Free the widget_value objects we used to specify the contents. */
2076 free_menubar_widget_value_tree (first_wv);
2077
2078 /* No selection has been chosen yet. */
2079 menu_item_selection = 0;
2080
2081 /* Display the menu. */
2082 lw_pop_up_all_widgets (dialog_id);
2083 popup_activated_flag = 1;
2084
2085 /* Process events that apply to the menu. */
2086 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2087
2088 lw_destroy_all_widgets (dialog_id);
2089
2090 /* Find the selected item, and its pane, to return
2091 the proper value. */
2092 if (menu_item_selection != 0)
2093 {
2094 Lisp_Object prefix;
2095
2096 prefix = Qnil;
2097 i = 0;
2098 while (i < menu_items_used)
2099 {
2100 Lisp_Object entry;
2101
2102 if (EQ (AREF (menu_items, i), Qt))
2103 {
2104 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2105 i += MENU_ITEMS_PANE_LENGTH;
2106 }
2107 else
2108 {
2109 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2110 if (menu_item_selection == i)
2111 {
2112 if (keymaps != 0)
2113 {
2114 entry = Fcons (entry, Qnil);
2115 if (!NILP (prefix))
2116 entry = Fcons (prefix, entry);
2117 }
2118 return entry;
2119 }
2120 i += MENU_ITEMS_ITEM_LENGTH;
2121 }
2122 }
2123 }
2124
2125 return Qnil;
2126 }
2127 #endif /* HAVE_DIALOGS */
2128 \f
2129
2130 /* Is this item a separator? */
2131 static int
2132 name_is_separator (name)
2133 char *name;
2134 {
2135 char *start = name;
2136
2137 /* Check if name string consists of only dashes ('-'). */
2138 while (*name == '-') name++;
2139 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2140 or "--deep-shadow". We don't implement them yet, se we just treat
2141 them like normal separators. */
2142 return (*name == '\0' || start + 2 == name);
2143 }
2144
2145
2146 /* Indicate boundary between left and right. */
2147 static int
2148 add_left_right_boundary (HMENU menu)
2149 {
2150 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2151 }
2152
2153 static int
2154 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2155 {
2156 UINT fuFlags;
2157 char *out_string;
2158 int return_value;
2159
2160 if (name_is_separator (wv->name))
2161 {
2162 fuFlags = MF_SEPARATOR;
2163 out_string = NULL;
2164 }
2165 else
2166 {
2167 if (wv->enabled)
2168 fuFlags = MF_STRING;
2169 else
2170 fuFlags = MF_STRING | MF_GRAYED;
2171
2172 if (wv->key != NULL)
2173 {
2174 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2175 strcpy (out_string, wv->name);
2176 strcat (out_string, "\t");
2177 strcat (out_string, wv->key);
2178 }
2179 else
2180 out_string = wv->name;
2181
2182 if (item != NULL)
2183 fuFlags = MF_POPUP;
2184 else if (wv->title || wv->call_data == 0)
2185 {
2186 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2187 we can't deallocate the memory otherwise. */
2188 if (get_menu_item_info)
2189 {
2190 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2191 strcpy (out_string, wv->name);
2192 #ifdef MENU_DEBUG
2193 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2194 #endif
2195 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2196 }
2197 else
2198 fuFlags = MF_DISABLED;
2199 }
2200
2201 /* Draw radio buttons and tickboxes. */
2202 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2203 wv->button_type == BUTTON_TYPE_RADIO))
2204 fuFlags |= MF_CHECKED;
2205 else
2206 fuFlags |= MF_UNCHECKED;
2207 }
2208
2209 return_value =
2210 AppendMenu (menu,
2211 fuFlags,
2212 item != NULL ? (UINT) item : (UINT) wv->call_data,
2213 out_string );
2214
2215 /* This must be done after the menu item is created. */
2216 if (!wv->title && wv->call_data != 0)
2217 {
2218 if (set_menu_item_info)
2219 {
2220 MENUITEMINFO info;
2221 bzero (&info, sizeof (info));
2222 info.cbSize = sizeof (info);
2223 info.fMask = MIIM_DATA;
2224
2225 /* Set help string for menu item. Leave it as a Lisp_Object
2226 until it is ready to be displayed, since GC can happen while
2227 menus are active. */
2228 if (!NILP (wv->help))
2229 #ifdef USE_LISP_UNION_TYPE
2230 info.dwItemData = (DWORD) (wv->help).i;
2231 #else
2232 info.dwItemData = (DWORD) (wv->help);
2233 #endif
2234 if (wv->button_type == BUTTON_TYPE_RADIO)
2235 {
2236 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2237 RADIO items, but is not available on NT 3.51 and earlier. */
2238 info.fMask |= MIIM_TYPE | MIIM_STATE;
2239 info.fType = MFT_RADIOCHECK | MFT_STRING;
2240 info.dwTypeData = out_string;
2241 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2242 }
2243
2244 set_menu_item_info (menu,
2245 item != NULL ? (UINT) item : (UINT) wv->call_data,
2246 FALSE, &info);
2247 }
2248 }
2249 return return_value;
2250 }
2251
2252 /* Construct native Windows menu(bar) based on widget_value tree. */
2253 int
2254 fill_in_menu (HMENU menu, widget_value *wv)
2255 {
2256 int items_added = 0;
2257
2258 for ( ; wv != NULL; wv = wv->next)
2259 {
2260 if (wv->contents)
2261 {
2262 HMENU sub_menu = CreatePopupMenu ();
2263
2264 if (sub_menu == NULL)
2265 return 0;
2266
2267 if (!fill_in_menu (sub_menu, wv->contents) ||
2268 !add_menu_item (menu, wv, sub_menu))
2269 {
2270 DestroyMenu (sub_menu);
2271 return 0;
2272 }
2273 }
2274 else
2275 {
2276 if (!add_menu_item (menu, wv, NULL))
2277 return 0;
2278 }
2279 }
2280 return 1;
2281 }
2282
2283 int
2284 popup_activated ()
2285 {
2286 /* popup_activated_flag not actually used on W32 */
2287 return 0;
2288 }
2289
2290 /* Display help string for currently pointed to menu item. Not
2291 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2292 available. */
2293 void
2294 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2295 {
2296 if (get_menu_item_info)
2297 {
2298 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2299 Lisp_Object frame, help;
2300
2301 // No help echo on owner-draw menu items.
2302 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2303 help = Qnil;
2304 else
2305 {
2306 MENUITEMINFO info;
2307
2308 bzero (&info, sizeof (info));
2309 info.cbSize = sizeof (info);
2310 info.fMask = MIIM_DATA;
2311 get_menu_item_info (menu, item, FALSE, &info);
2312
2313 #ifdef USE_LISP_UNION_TYPE
2314 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2315 : Qnil;
2316 #else
2317 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2318 #endif
2319 }
2320
2321 /* Store the help echo in the keyboard buffer as the X toolkit
2322 version does, rather than directly showing it. This seems to
2323 solve the GC problems that were present when we based the
2324 Windows code on the non-toolkit version. */
2325 if (f)
2326 {
2327 XSETFRAME (frame, f);
2328 kbd_buffer_store_help_event (frame, help);
2329 }
2330 else
2331 /* X version has a loop through frames here, which doesn't
2332 appear to do anything, unless it has some side effect. */
2333 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2334 }
2335 }
2336
2337 /* Free memory used by owner-drawn strings. */
2338 static void
2339 w32_free_submenu_strings (menu)
2340 HMENU menu;
2341 {
2342 int i, num = GetMenuItemCount (menu);
2343 for (i = 0; i < num; i++)
2344 {
2345 MENUITEMINFO info;
2346 bzero (&info, sizeof (info));
2347 info.cbSize = sizeof (info);
2348 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2349
2350 get_menu_item_info (menu, i, TRUE, &info);
2351
2352 /* Owner-drawn names are held in dwItemData. */
2353 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2354 {
2355 #ifdef MENU_DEBUG
2356 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2357 #endif
2358 local_free (info.dwItemData);
2359 }
2360
2361 /* Recurse down submenus. */
2362 if (info.hSubMenu)
2363 w32_free_submenu_strings (info.hSubMenu);
2364 }
2365 }
2366
2367 void
2368 w32_free_menu_strings (hwnd)
2369 HWND hwnd;
2370 {
2371 HMENU menu = current_popup_menu;
2372
2373 if (get_menu_item_info)
2374 {
2375 /* If there is no popup menu active, free the strings from the frame's
2376 menubar. */
2377 if (!menu)
2378 menu = GetMenu (hwnd);
2379
2380 if (menu)
2381 w32_free_submenu_strings (menu);
2382 }
2383
2384 current_popup_menu = NULL;
2385 }
2386
2387 #endif /* HAVE_MENUS */
2388
2389 void syms_of_w32menu ()
2390 {
2391 globals_of_w32menu ();
2392 staticpro (&menu_items);
2393 menu_items = Qnil;
2394
2395 current_popup_menu = NULL;
2396
2397 Qdebug_on_next_call = intern ("debug-on-next-call");
2398 staticpro (&Qdebug_on_next_call);
2399
2400 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2401 doc: /* Frame for which we are updating a menu.
2402 The enable predicate for a menu command should check this variable. */);
2403 Vmenu_updating_frame = Qnil;
2404
2405 defsubr (&Sx_popup_menu);
2406 #ifdef HAVE_MENUS
2407 defsubr (&Sx_popup_dialog);
2408 #endif
2409 }
2410
2411 /*
2412 globals_of_w32menu is used to initialize those global variables that
2413 must always be initialized on startup even when the global variable
2414 initialized is non zero (see the function main in emacs.c).
2415 globals_of_w32menu is called from syms_of_w32menu when the global
2416 variable initialized is 0 and directly from main when initialized
2417 is non zero.
2418 */
2419 void globals_of_w32menu ()
2420 {
2421 /* See if Get/SetMenuItemInfo functions are available. */
2422 HMODULE user32 = GetModuleHandle ("user32.dll");
2423 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2424 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2425 }
2426
2427 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2428 (do not change this comment) */