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