(translate_char): Accept list of translation tables.
[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 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 = WINDOW_LEFT_EDGE_X (XWINDOW (window));
729 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
730 }
731 else
732 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
733 but I don't want to make one now. */
734 CHECK_WINDOW (window);
735
736 xpos += XINT (x);
737 ypos += XINT (y);
738
739 XSETFRAME (Vmenu_updating_frame, f);
740 }
741 Vmenu_updating_frame = Qnil;
742 #endif /* HAVE_MENUS */
743
744 title = Qnil;
745 GCPRO1 (title);
746
747 /* Decode the menu items from what was specified. */
748
749 keymap = get_keymap (menu, 0, 0);
750 if (CONSP (keymap))
751 {
752 /* We were given a keymap. Extract menu info from the keymap. */
753 Lisp_Object prompt;
754
755 /* Extract the detailed info to make one pane. */
756 keymap_panes (&menu, 1, NILP (position));
757
758 /* Search for a string appearing directly as an element of the keymap.
759 That string is the title of the menu. */
760 prompt = Fkeymap_prompt (keymap);
761 if (NILP (title) && !NILP (prompt))
762 title = prompt;
763
764 /* Make that be the pane title of the first pane. */
765 if (!NILP (prompt) && menu_items_n_panes >= 0)
766 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
767
768 keymaps = 1;
769 }
770 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
771 {
772 /* We were given a list of keymaps. */
773 int nmaps = XFASTINT (Flength (menu));
774 Lisp_Object *maps
775 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
776 int i;
777
778 title = Qnil;
779
780 /* The first keymap that has a prompt string
781 supplies the menu title. */
782 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
783 {
784 Lisp_Object prompt;
785
786 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
787
788 prompt = Fkeymap_prompt (keymap);
789 if (NILP (title) && !NILP (prompt))
790 title = prompt;
791 }
792
793 /* Extract the detailed info to make one pane. */
794 keymap_panes (maps, nmaps, NILP (position));
795
796 /* Make the title be the pane title of the first pane. */
797 if (!NILP (title) && menu_items_n_panes >= 0)
798 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
799
800 keymaps = 1;
801 }
802 else
803 {
804 /* We were given an old-fashioned menu. */
805 title = Fcar (menu);
806 CHECK_STRING (title);
807
808 list_of_panes (Fcdr (menu));
809
810 keymaps = 0;
811 }
812
813 if (NILP (position))
814 {
815 discard_menu_items ();
816 UNGCPRO;
817 return Qnil;
818 }
819
820 #ifdef HAVE_MENUS
821 /* If resources from a previous popup menu exist yet, does nothing
822 until the `menu_free_timer' has freed them (see w32fns.c).
823 */
824 if (current_popup_menu)
825 {
826 discard_menu_items ();
827 UNGCPRO;
828 return Qnil;
829 }
830
831 /* Display them in a menu. */
832 BLOCK_INPUT;
833
834 selection = w32_menu_show (f, xpos, ypos, for_click,
835 keymaps, title, &error_name);
836 UNBLOCK_INPUT;
837
838 discard_menu_items ();
839 #endif /* HAVE_MENUS */
840
841 UNGCPRO;
842
843 if (error_name) error (error_name);
844 return selection;
845 }
846
847 #ifdef HAVE_MENUS
848
849 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
850 doc: /* Pop up a dialog box and return user's selection.
851 POSITION specifies which frame to use.
852 This is normally a mouse button event or a window or frame.
853 If POSITION is t, it means to use the frame the mouse is on.
854 The dialog box appears in the middle of the specified frame.
855
856 CONTENTS specifies the alternatives to display in the dialog box.
857 It is a list of the form (TITLE ITEM1 ITEM2...).
858 Each ITEM is a cons cell (STRING . VALUE).
859 The return value is VALUE from the chosen item.
860
861 An ITEM may also be just a string--that makes a nonselectable item.
862 An ITEM may also be nil--that means to put all preceding items
863 on the left of the dialog box and all following items on the right.
864 \(By default, approximately half appear on each side.) */)
865 (position, contents)
866 Lisp_Object position, contents;
867 {
868 FRAME_PTR f = NULL;
869 Lisp_Object window;
870
871 check_w32 ();
872
873 /* Decode the first argument: find the window or frame to use. */
874 if (EQ (position, Qt)
875 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
876 || EQ (XCAR (position), Qtool_bar))))
877 {
878 #if 0 /* Using the frame the mouse is on may not be right. */
879 /* Use the mouse's current position. */
880 FRAME_PTR new_f = SELECTED_FRAME ();
881 Lisp_Object bar_window;
882 enum scroll_bar_part part;
883 unsigned long time;
884 Lisp_Object x, y;
885
886 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
887
888 if (new_f != 0)
889 XSETFRAME (window, new_f);
890 else
891 window = selected_window;
892 #endif
893 window = selected_window;
894 }
895 else if (CONSP (position))
896 {
897 Lisp_Object tem;
898 tem = Fcar (position);
899 if (CONSP (tem))
900 window = Fcar (Fcdr (position));
901 else
902 {
903 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
904 window = Fcar (tem); /* POSN_WINDOW (tem) */
905 }
906 }
907 else if (WINDOWP (position) || FRAMEP (position))
908 window = position;
909 else
910 window = Qnil;
911
912 /* Decode where to put the menu. */
913
914 if (FRAMEP (window))
915 f = XFRAME (window);
916 else if (WINDOWP (window))
917 {
918 CHECK_LIVE_WINDOW (window);
919 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
920 }
921 else
922 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
923 but I don't want to make one now. */
924 CHECK_WINDOW (window);
925
926 #ifndef HAVE_DIALOGS
927 /* Display a menu with these alternatives
928 in the middle of frame F. */
929 {
930 Lisp_Object x, y, frame, newpos;
931 XSETFRAME (frame, f);
932 XSETINT (x, x_pixel_width (f) / 2);
933 XSETINT (y, x_pixel_height (f) / 2);
934 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
935
936 return Fx_popup_menu (newpos,
937 Fcons (Fcar (contents), Fcons (contents, Qnil)));
938 }
939 #else /* HAVE_DIALOGS */
940 {
941 Lisp_Object title;
942 char *error_name;
943 Lisp_Object selection;
944
945 /* Decode the dialog items from what was specified. */
946 title = Fcar (contents);
947 CHECK_STRING (title);
948
949 list_of_panes (Fcons (contents, Qnil));
950
951 /* Display them in a dialog box. */
952 BLOCK_INPUT;
953 selection = w32_dialog_show (f, 0, title, &error_name);
954 UNBLOCK_INPUT;
955
956 discard_menu_items ();
957
958 if (error_name) error (error_name);
959 return selection;
960 }
961 #endif /* HAVE_DIALOGS */
962 }
963
964 /* Activate the menu bar of frame F.
965 This is called from keyboard.c when it gets the
966 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
967
968 To activate the menu bar, we signal to the input thread that it can
969 return from the WM_INITMENU message, allowing the normal Windows
970 processing of the menus.
971
972 But first we recompute the menu bar contents (the whole tree).
973
974 This way we can safely execute Lisp code. */
975
976 void
977 x_activate_menubar (f)
978 FRAME_PTR f;
979 {
980 set_frame_menubar (f, 0, 1);
981
982 /* Lock out further menubar changes while active. */
983 f->output_data.w32->menubar_active = 1;
984
985 /* Signal input thread to return from WM_INITMENU. */
986 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
987 }
988
989 /* This callback is called from the menu bar pulldown menu
990 when the user makes a selection.
991 Figure out what the user chose
992 and put the appropriate events into the keyboard buffer. */
993
994 void
995 menubar_selection_callback (FRAME_PTR f, void * client_data)
996 {
997 Lisp_Object prefix, entry;
998 Lisp_Object vector;
999 Lisp_Object *subprefix_stack;
1000 int submenu_depth = 0;
1001 int i;
1002
1003 if (!f)
1004 return;
1005 entry = Qnil;
1006 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1007 vector = f->menu_bar_vector;
1008 prefix = Qnil;
1009 i = 0;
1010 while (i < f->menu_bar_items_used)
1011 {
1012 if (EQ (AREF (vector, i), Qnil))
1013 {
1014 subprefix_stack[submenu_depth++] = prefix;
1015 prefix = entry;
1016 i++;
1017 }
1018 else if (EQ (AREF (vector, i), Qlambda))
1019 {
1020 prefix = subprefix_stack[--submenu_depth];
1021 i++;
1022 }
1023 else if (EQ (AREF (vector, i), Qt))
1024 {
1025 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1026 i += MENU_ITEMS_PANE_LENGTH;
1027 }
1028 else
1029 {
1030 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1031 /* The EMACS_INT cast avoids a warning. There's no problem
1032 as long as pointers have enough bits to hold small integers. */
1033 if ((int) (EMACS_INT) client_data == i)
1034 {
1035 int j;
1036 struct input_event buf;
1037 Lisp_Object frame;
1038 EVENT_INIT (buf);
1039
1040 XSETFRAME (frame, f);
1041 buf.kind = MENU_BAR_EVENT;
1042 buf.frame_or_window = frame;
1043 buf.arg = frame;
1044 kbd_buffer_store_event (&buf);
1045
1046 for (j = 0; j < submenu_depth; j++)
1047 if (!NILP (subprefix_stack[j]))
1048 {
1049 buf.kind = MENU_BAR_EVENT;
1050 buf.frame_or_window = frame;
1051 buf.arg = subprefix_stack[j];
1052 kbd_buffer_store_event (&buf);
1053 }
1054
1055 if (!NILP (prefix))
1056 {
1057 buf.kind = MENU_BAR_EVENT;
1058 buf.frame_or_window = frame;
1059 buf.arg = prefix;
1060 kbd_buffer_store_event (&buf);
1061 }
1062
1063 buf.kind = MENU_BAR_EVENT;
1064 buf.frame_or_window = frame;
1065 buf.arg = entry;
1066 kbd_buffer_store_event (&buf);
1067
1068 /* Free memory used by owner-drawn and help-echo strings. */
1069 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1070 f->output_data.w32->menu_command_in_progress = 0;
1071 f->output_data.w32->menubar_active = 0;
1072 return;
1073 }
1074 i += MENU_ITEMS_ITEM_LENGTH;
1075 }
1076 }
1077 /* Free memory used by owner-drawn and help-echo strings. */
1078 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1079 f->output_data.w32->menu_command_in_progress = 0;
1080 f->output_data.w32->menubar_active = 0;
1081 }
1082
1083 /* Allocate a widget_value, blocking input. */
1084
1085 widget_value *
1086 xmalloc_widget_value ()
1087 {
1088 widget_value *value;
1089
1090 BLOCK_INPUT;
1091 value = malloc_widget_value ();
1092 UNBLOCK_INPUT;
1093
1094 return value;
1095 }
1096
1097 /* This recursively calls free_widget_value on the tree of widgets.
1098 It must free all data that was malloc'ed for these widget_values.
1099 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1100 must be left alone. */
1101
1102 void
1103 free_menubar_widget_value_tree (wv)
1104 widget_value *wv;
1105 {
1106 if (! wv) return;
1107
1108 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1109
1110 if (wv->contents && (wv->contents != (widget_value*)1))
1111 {
1112 free_menubar_widget_value_tree (wv->contents);
1113 wv->contents = (widget_value *) 0xDEADBEEF;
1114 }
1115 if (wv->next)
1116 {
1117 free_menubar_widget_value_tree (wv->next);
1118 wv->next = (widget_value *) 0xDEADBEEF;
1119 }
1120 BLOCK_INPUT;
1121 free_widget_value (wv);
1122 UNBLOCK_INPUT;
1123 }
1124 \f
1125 /* Set up data i menu_items for a menu bar item
1126 whose event type is ITEM_KEY (with string ITEM_NAME)
1127 and whose contents come from the list of keymaps MAPS. */
1128
1129 static int
1130 parse_single_submenu (item_key, item_name, maps)
1131 Lisp_Object item_key, item_name, maps;
1132 {
1133 Lisp_Object length;
1134 int len;
1135 Lisp_Object *mapvec;
1136 int i;
1137 int top_level_items = 0;
1138
1139 length = Flength (maps);
1140 len = XINT (length);
1141
1142 /* Convert the list MAPS into a vector MAPVEC. */
1143 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1144 for (i = 0; i < len; i++)
1145 {
1146 mapvec[i] = Fcar (maps);
1147 maps = Fcdr (maps);
1148 }
1149
1150 /* Loop over the given keymaps, making a pane for each map.
1151 But don't make a pane that is empty--ignore that map instead. */
1152 for (i = 0; i < len; i++)
1153 {
1154 if (SYMBOLP (mapvec[i])
1155 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1156 {
1157 /* Here we have a command at top level in the menu bar
1158 as opposed to a submenu. */
1159 top_level_items = 1;
1160 push_menu_pane (Qnil, Qnil);
1161 push_menu_item (item_name, Qt, item_key, mapvec[i],
1162 Qnil, Qnil, Qnil, Qnil);
1163 }
1164 else
1165 {
1166 Lisp_Object prompt;
1167 prompt = Fkeymap_prompt (mapvec[i]);
1168 single_keymap_panes (mapvec[i],
1169 !NILP (prompt) ? prompt : item_name,
1170 item_key, 0, 10);
1171 }
1172 }
1173
1174 return top_level_items;
1175 }
1176
1177
1178 /* Create a tree of widget_value objects
1179 representing the panes and items
1180 in menu_items starting at index START, up to index END. */
1181
1182 static widget_value *
1183 digest_single_submenu (start, end, top_level_items)
1184 int start, end, top_level_items;
1185 {
1186 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1187 int i;
1188 int submenu_depth = 0;
1189 widget_value **submenu_stack;
1190
1191 submenu_stack
1192 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1193 wv = xmalloc_widget_value ();
1194 wv->name = "menu";
1195 wv->value = 0;
1196 wv->enabled = 1;
1197 wv->button_type = BUTTON_TYPE_NONE;
1198 wv->help = Qnil;
1199 first_wv = wv;
1200 save_wv = 0;
1201 prev_wv = 0;
1202
1203 /* Loop over all panes and items made by the preceding call
1204 to parse_single_submenu and construct a tree of widget_value objects.
1205 Ignore the panes and items used by previous calls to
1206 digest_single_submenu, even though those are also in menu_items. */
1207 i = start;
1208 while (i < end)
1209 {
1210 if (EQ (AREF (menu_items, i), Qnil))
1211 {
1212 submenu_stack[submenu_depth++] = save_wv;
1213 save_wv = prev_wv;
1214 prev_wv = 0;
1215 i++;
1216 }
1217 else if (EQ (AREF (menu_items, i), Qlambda))
1218 {
1219 prev_wv = save_wv;
1220 save_wv = submenu_stack[--submenu_depth];
1221 i++;
1222 }
1223 else if (EQ (AREF (menu_items, i), Qt)
1224 && submenu_depth != 0)
1225 i += MENU_ITEMS_PANE_LENGTH;
1226 /* Ignore a nil in the item list.
1227 It's meaningful only for dialog boxes. */
1228 else if (EQ (AREF (menu_items, i), Qquote))
1229 i += 1;
1230 else if (EQ (AREF (menu_items, i), Qt))
1231 {
1232 /* Create a new pane. */
1233 Lisp_Object pane_name, prefix;
1234 char *pane_string;
1235
1236 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1237 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1238
1239 #ifndef HAVE_MULTILINGUAL_MENU
1240 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1241 {
1242 pane_name = ENCODE_SYSTEM (pane_name);
1243 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1244 }
1245 #endif
1246 pane_string = (NILP (pane_name)
1247 ? "" : (char *) SDATA (pane_name));
1248 /* If there is just one top-level pane, put all its items directly
1249 under the top-level menu. */
1250 if (menu_items_n_panes == 1)
1251 pane_string = "";
1252
1253 /* If the pane has a meaningful name,
1254 make the pane a top-level menu item
1255 with its items as a submenu beneath it. */
1256 if (strcmp (pane_string, ""))
1257 {
1258 wv = xmalloc_widget_value ();
1259 if (save_wv)
1260 save_wv->next = wv;
1261 else
1262 first_wv->contents = wv;
1263 wv->name = pane_string;
1264 /* Ignore the @ that means "separate pane".
1265 This is a kludge, but this isn't worth more time. */
1266 if (!NILP (prefix) && wv->name[0] == '@')
1267 wv->name++;
1268 wv->value = 0;
1269 wv->enabled = 1;
1270 wv->button_type = BUTTON_TYPE_NONE;
1271 wv->help = Qnil;
1272 }
1273 save_wv = wv;
1274 prev_wv = 0;
1275 i += MENU_ITEMS_PANE_LENGTH;
1276 }
1277 else
1278 {
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name, enable, descrip, def, type, selected;
1281 Lisp_Object help;
1282
1283 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1284 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1285 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1286 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1287 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1288 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1289 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1290
1291 #ifndef HAVE_MULTILINGUAL_MENU
1292 if (STRING_MULTIBYTE (item_name))
1293 {
1294 item_name = ENCODE_SYSTEM (item_name);
1295 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1296 }
1297
1298 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1299 {
1300 descrip = ENCODE_SYSTEM (descrip);
1301 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1302 }
1303 #endif /* not HAVE_MULTILINGUAL_MENU */
1304
1305 wv = xmalloc_widget_value ();
1306 if (prev_wv)
1307 prev_wv->next = wv;
1308 else
1309 save_wv->contents = wv;
1310
1311 wv->name = (char *) SDATA (item_name);
1312 if (!NILP (descrip))
1313 wv->key = (char *) SDATA (descrip);
1314 wv->value = 0;
1315 /* The EMACS_INT cast avoids a warning. There's no problem
1316 as long as pointers have enough bits to hold small integers. */
1317 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1318 wv->enabled = !NILP (enable);
1319
1320 if (NILP (type))
1321 wv->button_type = BUTTON_TYPE_NONE;
1322 else if (EQ (type, QCradio))
1323 wv->button_type = BUTTON_TYPE_RADIO;
1324 else if (EQ (type, QCtoggle))
1325 wv->button_type = BUTTON_TYPE_TOGGLE;
1326 else
1327 abort ();
1328
1329 wv->selected = !NILP (selected);
1330 if (!STRINGP (help))
1331 help = Qnil;
1332
1333 wv->help = help;
1334
1335 prev_wv = wv;
1336
1337 i += MENU_ITEMS_ITEM_LENGTH;
1338 }
1339 }
1340
1341 /* If we have just one "menu item"
1342 that was originally a button, return it by itself. */
1343 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1344 {
1345 wv = first_wv->contents;
1346 free_widget_value (first_wv);
1347 return wv;
1348 }
1349
1350 return first_wv;
1351 }
1352 \f
1353 /* Set the contents of the menubar widgets of frame F.
1354 The argument FIRST_TIME is currently ignored;
1355 it is set the first time this is called, from initialize_frame_menubar. */
1356
1357 void
1358 set_frame_menubar (f, first_time, deep_p)
1359 FRAME_PTR f;
1360 int first_time;
1361 int deep_p;
1362 {
1363 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1364 Lisp_Object items;
1365 widget_value *wv, *first_wv, *prev_wv = 0;
1366 int i, last_i;
1367 int *submenu_start, *submenu_end;
1368 int *submenu_top_level_items, *submenu_n_panes;
1369
1370 /* We must not change the menubar when actually in use. */
1371 if (f->output_data.w32->menubar_active)
1372 return;
1373
1374 XSETFRAME (Vmenu_updating_frame, f);
1375
1376 if (! menubar_widget)
1377 deep_p = 1;
1378 else if (pending_menu_activation && !deep_p)
1379 deep_p = 1;
1380
1381 if (deep_p)
1382 {
1383 /* Make a widget-value tree representing the entire menu trees. */
1384
1385 struct buffer *prev = current_buffer;
1386 Lisp_Object buffer;
1387 int specpdl_count = SPECPDL_INDEX ();
1388 int previous_menu_items_used = f->menu_bar_items_used;
1389 Lisp_Object *previous_items
1390 = (Lisp_Object *) alloca (previous_menu_items_used
1391 * sizeof (Lisp_Object));
1392
1393 /* If we are making a new widget, its contents are empty,
1394 do always reinitialize them. */
1395 if (! menubar_widget)
1396 previous_menu_items_used = 0;
1397
1398 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1399 specbind (Qinhibit_quit, Qt);
1400 /* Don't let the debugger step into this code
1401 because it is not reentrant. */
1402 specbind (Qdebug_on_next_call, Qnil);
1403
1404 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1405 if (NILP (Voverriding_local_map_menu_flag))
1406 {
1407 specbind (Qoverriding_terminal_local_map, Qnil);
1408 specbind (Qoverriding_local_map, Qnil);
1409 }
1410
1411 set_buffer_internal_1 (XBUFFER (buffer));
1412
1413 /* Run the Lucid hook. */
1414 safe_run_hooks (Qactivate_menubar_hook);
1415 /* If it has changed current-menubar from previous value,
1416 really recompute the menubar from the value. */
1417 if (! NILP (Vlucid_menu_bar_dirty_flag))
1418 call0 (Qrecompute_lucid_menubar);
1419 safe_run_hooks (Qmenu_bar_update_hook);
1420 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1421
1422 items = FRAME_MENU_BAR_ITEMS (f);
1423
1424 /* Save the frame's previous menu bar contents data. */
1425 if (previous_menu_items_used)
1426 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1427 previous_menu_items_used * sizeof (Lisp_Object));
1428
1429 /* Fill in menu_items with the current menu bar contents.
1430 This can evaluate Lisp code. */
1431 menu_items = f->menu_bar_vector;
1432 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1433 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1434 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1435 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1436 submenu_top_level_items
1437 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1438 init_menu_items ();
1439 for (i = 0; i < ASIZE (items); i += 4)
1440 {
1441 Lisp_Object key, string, maps;
1442
1443 last_i = i;
1444
1445 key = AREF (items, i);
1446 string = AREF (items, i + 1);
1447 maps = AREF (items, i + 2);
1448 if (NILP (string))
1449 break;
1450
1451 submenu_start[i] = menu_items_used;
1452
1453 menu_items_n_panes = 0;
1454 submenu_top_level_items[i]
1455 = parse_single_submenu (key, string, maps);
1456 submenu_n_panes[i] = menu_items_n_panes;
1457
1458 submenu_end[i] = menu_items_used;
1459 }
1460
1461 finish_menu_items ();
1462
1463 /* Convert menu_items into widget_value trees
1464 to display the menu. This cannot evaluate Lisp code. */
1465
1466 wv = xmalloc_widget_value ();
1467 wv->name = "menubar";
1468 wv->value = 0;
1469 wv->enabled = 1;
1470 wv->button_type = BUTTON_TYPE_NONE;
1471 wv->help = Qnil;
1472 first_wv = wv;
1473
1474 for (i = 0; i < last_i; i += 4)
1475 {
1476 menu_items_n_panes = submenu_n_panes[i];
1477 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1478 submenu_top_level_items[i]);
1479 if (prev_wv)
1480 prev_wv->next = wv;
1481 else
1482 first_wv->contents = wv;
1483 /* Don't set wv->name here; GC during the loop might relocate it. */
1484 wv->enabled = 1;
1485 wv->button_type = BUTTON_TYPE_NONE;
1486 prev_wv = wv;
1487 }
1488
1489 set_buffer_internal_1 (prev);
1490 unbind_to (specpdl_count, Qnil);
1491
1492 /* If there has been no change in the Lisp-level contents
1493 of the menu bar, skip redisplaying it. Just exit. */
1494
1495 for (i = 0; i < previous_menu_items_used; i++)
1496 if (menu_items_used == i
1497 || (!EQ (previous_items[i], AREF (menu_items, i))))
1498 break;
1499 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1500 {
1501 free_menubar_widget_value_tree (first_wv);
1502 menu_items = Qnil;
1503
1504 return;
1505 }
1506
1507 /* Now GC cannot happen during the lifetime of the widget_value,
1508 so it's safe to store data from a Lisp_String, as long as
1509 local copies are made when the actual menu is created.
1510 Windows takes care of this for normal string items, but
1511 not for owner-drawn items or additional item-info. */
1512 wv = first_wv->contents;
1513 for (i = 0; i < ASIZE (items); i += 4)
1514 {
1515 Lisp_Object string;
1516 string = AREF (items, i + 1);
1517 if (NILP (string))
1518 break;
1519 wv->name = (char *) SDATA (string);
1520 wv = wv->next;
1521 }
1522
1523 f->menu_bar_vector = menu_items;
1524 f->menu_bar_items_used = menu_items_used;
1525 menu_items = Qnil;
1526 }
1527 else
1528 {
1529 /* Make a widget-value tree containing
1530 just the top level menu bar strings. */
1531
1532 wv = xmalloc_widget_value ();
1533 wv->name = "menubar";
1534 wv->value = 0;
1535 wv->enabled = 1;
1536 wv->button_type = BUTTON_TYPE_NONE;
1537 wv->help = Qnil;
1538 first_wv = wv;
1539
1540 items = FRAME_MENU_BAR_ITEMS (f);
1541 for (i = 0; i < ASIZE (items); i += 4)
1542 {
1543 Lisp_Object string;
1544
1545 string = AREF (items, i + 1);
1546 if (NILP (string))
1547 break;
1548
1549 wv = xmalloc_widget_value ();
1550 wv->name = (char *) SDATA (string);
1551 wv->value = 0;
1552 wv->enabled = 1;
1553 wv->button_type = BUTTON_TYPE_NONE;
1554 wv->help = Qnil;
1555 /* This prevents lwlib from assuming this
1556 menu item is really supposed to be empty. */
1557 /* The EMACS_INT cast avoids a warning.
1558 This value just has to be different from small integers. */
1559 wv->call_data = (void *) (EMACS_INT) (-1);
1560
1561 if (prev_wv)
1562 prev_wv->next = wv;
1563 else
1564 first_wv->contents = wv;
1565 prev_wv = wv;
1566 }
1567
1568 /* Forget what we thought we knew about what is in the
1569 detailed contents of the menu bar menus.
1570 Changing the top level always destroys the contents. */
1571 f->menu_bar_items_used = 0;
1572 }
1573
1574 /* Create or update the menu bar widget. */
1575
1576 BLOCK_INPUT;
1577
1578 if (menubar_widget)
1579 {
1580 /* Empty current menubar, rather than creating a fresh one. */
1581 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1582 ;
1583 }
1584 else
1585 {
1586 menubar_widget = CreateMenu ();
1587 }
1588 fill_in_menu (menubar_widget, first_wv->contents);
1589
1590 free_menubar_widget_value_tree (first_wv);
1591
1592 {
1593 HMENU old_widget = f->output_data.w32->menubar_widget;
1594
1595 f->output_data.w32->menubar_widget = menubar_widget;
1596 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1597 /* Causes flicker when menu bar is updated
1598 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1599
1600 /* Force the window size to be recomputed so that the frame's text
1601 area remains the same, if menubar has just been created. */
1602 if (old_widget == NULL)
1603 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1604 }
1605
1606 UNBLOCK_INPUT;
1607 }
1608
1609 /* Called from Fx_create_frame to create the initial menubar of a frame
1610 before it is mapped, so that the window is mapped with the menubar already
1611 there instead of us tacking it on later and thrashing the window after it
1612 is visible. */
1613
1614 void
1615 initialize_frame_menubar (f)
1616 FRAME_PTR f;
1617 {
1618 /* This function is called before the first chance to redisplay
1619 the frame. It has to be, so the frame will have the right size. */
1620 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1621 set_frame_menubar (f, 1, 1);
1622 }
1623
1624 /* Get rid of the menu bar of frame F, and free its storage.
1625 This is used when deleting a frame, and when turning off the menu bar. */
1626
1627 void
1628 free_frame_menubar (f)
1629 FRAME_PTR f;
1630 {
1631 BLOCK_INPUT;
1632
1633 {
1634 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1635 SetMenu (FRAME_W32_WINDOW (f), NULL);
1636 f->output_data.w32->menubar_widget = NULL;
1637 DestroyMenu (old);
1638 }
1639
1640 UNBLOCK_INPUT;
1641 }
1642
1643 \f
1644 /* w32_menu_show actually displays a menu using the panes and items in
1645 menu_items and returns the value selected from it; we assume input
1646 is blocked by the caller. */
1647
1648 /* F is the frame the menu is for.
1649 X and Y are the frame-relative specified position,
1650 relative to the inside upper left corner of the frame F.
1651 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1652 KEYMAPS is 1 if this menu was specified with keymaps;
1653 in that case, we return a list containing the chosen item's value
1654 and perhaps also the pane's prefix.
1655 TITLE is the specified menu title.
1656 ERROR is a place to store an error message string in case of failure.
1657 (We return nil on failure, but the value doesn't actually matter.) */
1658
1659 static Lisp_Object
1660 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1661 FRAME_PTR f;
1662 int x;
1663 int y;
1664 int for_click;
1665 int keymaps;
1666 Lisp_Object title;
1667 char **error;
1668 {
1669 int i;
1670 int menu_item_selection;
1671 HMENU menu;
1672 POINT pos;
1673 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1674 widget_value **submenu_stack
1675 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1676 Lisp_Object *subprefix_stack
1677 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1678 int submenu_depth = 0;
1679 int first_pane;
1680
1681 *error = NULL;
1682
1683 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1684 {
1685 *error = "Empty menu";
1686 return Qnil;
1687 }
1688
1689 /* Create a tree of widget_value objects
1690 representing the panes and their items. */
1691 wv = xmalloc_widget_value ();
1692 wv->name = "menu";
1693 wv->value = 0;
1694 wv->enabled = 1;
1695 wv->button_type = BUTTON_TYPE_NONE;
1696 wv->help = Qnil;
1697 first_wv = wv;
1698 first_pane = 1;
1699
1700 /* Loop over all panes and items, filling in the tree. */
1701 i = 0;
1702 while (i < menu_items_used)
1703 {
1704 if (EQ (AREF (menu_items, i), Qnil))
1705 {
1706 submenu_stack[submenu_depth++] = save_wv;
1707 save_wv = prev_wv;
1708 prev_wv = 0;
1709 first_pane = 1;
1710 i++;
1711 }
1712 else if (EQ (AREF (menu_items, i), Qlambda))
1713 {
1714 prev_wv = save_wv;
1715 save_wv = submenu_stack[--submenu_depth];
1716 first_pane = 0;
1717 i++;
1718 }
1719 else if (EQ (AREF (menu_items, i), Qt)
1720 && submenu_depth != 0)
1721 i += MENU_ITEMS_PANE_LENGTH;
1722 /* Ignore a nil in the item list.
1723 It's meaningful only for dialog boxes. */
1724 else if (EQ (AREF (menu_items, i), Qquote))
1725 i += 1;
1726 else if (EQ (AREF (menu_items, i), Qt))
1727 {
1728 /* Create a new pane. */
1729 Lisp_Object pane_name, prefix;
1730 char *pane_string;
1731 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1732 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1733 #ifndef HAVE_MULTILINGUAL_MENU
1734 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1735 {
1736 pane_name = ENCODE_SYSTEM (pane_name);
1737 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1738 }
1739 #endif
1740 pane_string = (NILP (pane_name)
1741 ? "" : (char *) SDATA (pane_name));
1742 /* If there is just one top-level pane, put all its items directly
1743 under the top-level menu. */
1744 if (menu_items_n_panes == 1)
1745 pane_string = "";
1746
1747 /* If the pane has a meaningful name,
1748 make the pane a top-level menu item
1749 with its items as a submenu beneath it. */
1750 if (!keymaps && strcmp (pane_string, ""))
1751 {
1752 wv = xmalloc_widget_value ();
1753 if (save_wv)
1754 save_wv->next = wv;
1755 else
1756 first_wv->contents = wv;
1757 wv->name = pane_string;
1758 if (keymaps && !NILP (prefix))
1759 wv->name++;
1760 wv->value = 0;
1761 wv->enabled = 1;
1762 wv->button_type = BUTTON_TYPE_NONE;
1763 wv->help = Qnil;
1764 save_wv = wv;
1765 prev_wv = 0;
1766 }
1767 else if (first_pane)
1768 {
1769 save_wv = wv;
1770 prev_wv = 0;
1771 }
1772 first_pane = 0;
1773 i += MENU_ITEMS_PANE_LENGTH;
1774 }
1775 else
1776 {
1777 /* Create a new item within current pane. */
1778 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1779
1780 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1781 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1782 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1783 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1784 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1785 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1786 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1787
1788 #ifndef HAVE_MULTILINGUAL_MENU
1789 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1790 {
1791 item_name = ENCODE_SYSTEM (item_name);
1792 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1793 }
1794 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1795 {
1796 descrip = ENCODE_SYSTEM (descrip);
1797 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1798 }
1799 #endif /* not HAVE_MULTILINGUAL_MENU */
1800
1801 wv = xmalloc_widget_value ();
1802 if (prev_wv)
1803 prev_wv->next = wv;
1804 else
1805 save_wv->contents = wv;
1806 wv->name = (char *) SDATA (item_name);
1807 if (!NILP (descrip))
1808 wv->key = (char *) SDATA (descrip);
1809 wv->value = 0;
1810 /* Use the contents index as call_data, since we are
1811 restricted to 16-bits. */
1812 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1813 wv->enabled = !NILP (enable);
1814
1815 if (NILP (type))
1816 wv->button_type = BUTTON_TYPE_NONE;
1817 else if (EQ (type, QCtoggle))
1818 wv->button_type = BUTTON_TYPE_TOGGLE;
1819 else if (EQ (type, QCradio))
1820 wv->button_type = BUTTON_TYPE_RADIO;
1821 else
1822 abort ();
1823
1824 wv->selected = !NILP (selected);
1825 if (!STRINGP (help))
1826 help = Qnil;
1827
1828 wv->help = help;
1829
1830 prev_wv = wv;
1831
1832 i += MENU_ITEMS_ITEM_LENGTH;
1833 }
1834 }
1835
1836 /* Deal with the title, if it is non-nil. */
1837 if (!NILP (title))
1838 {
1839 widget_value *wv_title = xmalloc_widget_value ();
1840 widget_value *wv_sep = xmalloc_widget_value ();
1841
1842 /* Maybe replace this separator with a bitmap or owner-draw item
1843 so that it looks better. Having two separators looks odd. */
1844 wv_sep->name = "--";
1845 wv_sep->next = first_wv->contents;
1846 wv_sep->help = Qnil;
1847
1848 #ifndef HAVE_MULTILINGUAL_MENU
1849 if (STRING_MULTIBYTE (title))
1850 title = ENCODE_SYSTEM (title);
1851 #endif
1852 wv_title->name = (char *) SDATA (title);
1853 wv_title->enabled = TRUE;
1854 wv_title->title = TRUE;
1855 wv_title->button_type = BUTTON_TYPE_NONE;
1856 wv_title->help = Qnil;
1857 wv_title->next = wv_sep;
1858 first_wv->contents = wv_title;
1859 }
1860
1861 /* Actually create the menu. */
1862 current_popup_menu = menu = CreatePopupMenu ();
1863 fill_in_menu (menu, first_wv->contents);
1864
1865 /* Adjust coordinates to be root-window-relative. */
1866 pos.x = x;
1867 pos.y = y;
1868 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1869
1870 /* No selection has been chosen yet. */
1871 menu_item_selection = 0;
1872
1873 /* Display the menu. */
1874 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1875 WM_EMACS_TRACKPOPUPMENU,
1876 (WPARAM)menu, (LPARAM)&pos);
1877
1878 /* Clean up extraneous mouse events which might have been generated
1879 during the call. */
1880 discard_mouse_events ();
1881
1882 /* Free the widget_value objects we used to specify the contents. */
1883 free_menubar_widget_value_tree (first_wv);
1884
1885 DestroyMenu (menu);
1886
1887 /* Find the selected item, and its pane, to return
1888 the proper value. */
1889 if (menu_item_selection != 0)
1890 {
1891 Lisp_Object prefix, entry;
1892
1893 prefix = entry = Qnil;
1894 i = 0;
1895 while (i < menu_items_used)
1896 {
1897 if (EQ (AREF (menu_items, i), Qnil))
1898 {
1899 subprefix_stack[submenu_depth++] = prefix;
1900 prefix = entry;
1901 i++;
1902 }
1903 else if (EQ (AREF (menu_items, i), Qlambda))
1904 {
1905 prefix = subprefix_stack[--submenu_depth];
1906 i++;
1907 }
1908 else if (EQ (AREF (menu_items, i), Qt))
1909 {
1910 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1911 i += MENU_ITEMS_PANE_LENGTH;
1912 }
1913 /* Ignore a nil in the item list.
1914 It's meaningful only for dialog boxes. */
1915 else if (EQ (AREF (menu_items, i), Qquote))
1916 i += 1;
1917 else
1918 {
1919 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1920 if (menu_item_selection == i)
1921 {
1922 if (keymaps != 0)
1923 {
1924 int j;
1925
1926 entry = Fcons (entry, Qnil);
1927 if (!NILP (prefix))
1928 entry = Fcons (prefix, entry);
1929 for (j = submenu_depth - 1; j >= 0; j--)
1930 if (!NILP (subprefix_stack[j]))
1931 entry = Fcons (subprefix_stack[j], entry);
1932 }
1933 return entry;
1934 }
1935 i += MENU_ITEMS_ITEM_LENGTH;
1936 }
1937 }
1938 }
1939
1940 return Qnil;
1941 }
1942 \f
1943
1944 #ifdef HAVE_DIALOGS
1945 static char * button_names [] = {
1946 "button1", "button2", "button3", "button4", "button5",
1947 "button6", "button7", "button8", "button9", "button10" };
1948
1949 static Lisp_Object
1950 w32_dialog_show (f, keymaps, title, error)
1951 FRAME_PTR f;
1952 int keymaps;
1953 Lisp_Object title;
1954 char **error;
1955 {
1956 int i, nb_buttons=0;
1957 char dialog_name[6];
1958 int menu_item_selection;
1959
1960 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1961
1962 /* Number of elements seen so far, before boundary. */
1963 int left_count = 0;
1964 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1965 int boundary_seen = 0;
1966
1967 *error = NULL;
1968
1969 if (menu_items_n_panes > 1)
1970 {
1971 *error = "Multiple panes in dialog box";
1972 return Qnil;
1973 }
1974
1975 /* Create a tree of widget_value objects
1976 representing the text label and buttons. */
1977 {
1978 Lisp_Object pane_name, prefix;
1979 char *pane_string;
1980 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
1981 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
1982 pane_string = (NILP (pane_name)
1983 ? "" : (char *) SDATA (pane_name));
1984 prev_wv = xmalloc_widget_value ();
1985 prev_wv->value = pane_string;
1986 if (keymaps && !NILP (prefix))
1987 prev_wv->name++;
1988 prev_wv->enabled = 1;
1989 prev_wv->name = "message";
1990 prev_wv->help = Qnil;
1991 first_wv = prev_wv;
1992
1993 /* Loop over all panes and items, filling in the tree. */
1994 i = MENU_ITEMS_PANE_LENGTH;
1995 while (i < menu_items_used)
1996 {
1997
1998 /* Create a new item within current pane. */
1999 Lisp_Object item_name, enable, descrip, help;
2000
2001 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2002 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2003 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2004 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2005
2006 if (NILP (item_name))
2007 {
2008 free_menubar_widget_value_tree (first_wv);
2009 *error = "Submenu in dialog items";
2010 return Qnil;
2011 }
2012 if (EQ (item_name, Qquote))
2013 {
2014 /* This is the boundary between left-side elts
2015 and right-side elts. Stop incrementing right_count. */
2016 boundary_seen = 1;
2017 i++;
2018 continue;
2019 }
2020 if (nb_buttons >= 9)
2021 {
2022 free_menubar_widget_value_tree (first_wv);
2023 *error = "Too many dialog items";
2024 return Qnil;
2025 }
2026
2027 wv = xmalloc_widget_value ();
2028 prev_wv->next = wv;
2029 wv->name = (char *) button_names[nb_buttons];
2030 if (!NILP (descrip))
2031 wv->key = (char *) SDATA (descrip);
2032 wv->value = (char *) SDATA (item_name);
2033 wv->call_data = (void *) &AREF (menu_items, i);
2034 wv->enabled = !NILP (enable);
2035 wv->help = Qnil;
2036 prev_wv = wv;
2037
2038 if (! boundary_seen)
2039 left_count++;
2040
2041 nb_buttons++;
2042 i += MENU_ITEMS_ITEM_LENGTH;
2043 }
2044
2045 /* If the boundary was not specified,
2046 by default put half on the left and half on the right. */
2047 if (! boundary_seen)
2048 left_count = nb_buttons - nb_buttons / 2;
2049
2050 wv = xmalloc_widget_value ();
2051 wv->name = dialog_name;
2052 wv->help = Qnil;
2053
2054 /* Dialog boxes use a really stupid name encoding
2055 which specifies how many buttons to use
2056 and how many buttons are on the right.
2057 The Q means something also. */
2058 dialog_name[0] = 'Q';
2059 dialog_name[1] = '0' + nb_buttons;
2060 dialog_name[2] = 'B';
2061 dialog_name[3] = 'R';
2062 /* Number of buttons to put on the right. */
2063 dialog_name[4] = '0' + nb_buttons - left_count;
2064 dialog_name[5] = 0;
2065 wv->contents = first_wv;
2066 first_wv = wv;
2067 }
2068
2069 /* Actually create the dialog. */
2070 dialog_id = widget_id_tick++;
2071 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2072 f->output_data.w32->widget, 1, 0,
2073 dialog_selection_callback, 0);
2074 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2075
2076 /* Free the widget_value objects we used to specify the contents. */
2077 free_menubar_widget_value_tree (first_wv);
2078
2079 /* No selection has been chosen yet. */
2080 menu_item_selection = 0;
2081
2082 /* Display the menu. */
2083 lw_pop_up_all_widgets (dialog_id);
2084 popup_activated_flag = 1;
2085
2086 /* Process events that apply to the menu. */
2087 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2088
2089 lw_destroy_all_widgets (dialog_id);
2090
2091 /* Find the selected item, and its pane, to return
2092 the proper value. */
2093 if (menu_item_selection != 0)
2094 {
2095 Lisp_Object prefix;
2096
2097 prefix = Qnil;
2098 i = 0;
2099 while (i < menu_items_used)
2100 {
2101 Lisp_Object entry;
2102
2103 if (EQ (AREF (menu_items, i), Qt))
2104 {
2105 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2106 i += MENU_ITEMS_PANE_LENGTH;
2107 }
2108 else
2109 {
2110 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2111 if (menu_item_selection == i)
2112 {
2113 if (keymaps != 0)
2114 {
2115 entry = Fcons (entry, Qnil);
2116 if (!NILP (prefix))
2117 entry = Fcons (prefix, entry);
2118 }
2119 return entry;
2120 }
2121 i += MENU_ITEMS_ITEM_LENGTH;
2122 }
2123 }
2124 }
2125
2126 return Qnil;
2127 }
2128 #endif /* HAVE_DIALOGS */
2129 \f
2130
2131 /* Is this item a separator? */
2132 static int
2133 name_is_separator (name)
2134 char *name;
2135 {
2136 char *start = name;
2137
2138 /* Check if name string consists of only dashes ('-'). */
2139 while (*name == '-') name++;
2140 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2141 or "--deep-shadow". We don't implement them yet, se we just treat
2142 them like normal separators. */
2143 return (*name == '\0' || start + 2 == name);
2144 }
2145
2146
2147 /* Indicate boundary between left and right. */
2148 static int
2149 add_left_right_boundary (HMENU menu)
2150 {
2151 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2152 }
2153
2154 static int
2155 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2156 {
2157 UINT fuFlags;
2158 char *out_string;
2159 int return_value;
2160
2161 if (name_is_separator (wv->name))
2162 {
2163 fuFlags = MF_SEPARATOR;
2164 out_string = NULL;
2165 }
2166 else
2167 {
2168 if (wv->enabled)
2169 fuFlags = MF_STRING;
2170 else
2171 fuFlags = MF_STRING | MF_GRAYED;
2172
2173 if (wv->key != NULL)
2174 {
2175 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2176 strcpy (out_string, wv->name);
2177 strcat (out_string, "\t");
2178 strcat (out_string, wv->key);
2179 }
2180 else
2181 out_string = wv->name;
2182
2183 if (item != NULL)
2184 fuFlags = MF_POPUP;
2185 else if (wv->title || wv->call_data == 0)
2186 {
2187 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2188 we can't deallocate the memory otherwise. */
2189 if (get_menu_item_info)
2190 {
2191 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2192 strcpy (out_string, wv->name);
2193 #ifdef MENU_DEBUG
2194 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2195 #endif
2196 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2197 }
2198 else
2199 fuFlags = MF_DISABLED;
2200 }
2201
2202 /* Draw radio buttons and tickboxes. */
2203 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2204 wv->button_type == BUTTON_TYPE_RADIO))
2205 fuFlags |= MF_CHECKED;
2206 else
2207 fuFlags |= MF_UNCHECKED;
2208 }
2209
2210 return_value =
2211 AppendMenu (menu,
2212 fuFlags,
2213 item != NULL ? (UINT) item : (UINT) wv->call_data,
2214 out_string );
2215
2216 /* This must be done after the menu item is created. */
2217 if (!wv->title && wv->call_data != 0)
2218 {
2219 if (set_menu_item_info)
2220 {
2221 MENUITEMINFO info;
2222 bzero (&info, sizeof (info));
2223 info.cbSize = sizeof (info);
2224 info.fMask = MIIM_DATA;
2225
2226 /* Set help string for menu item. Leave it as a Lisp_Object
2227 until it is ready to be displayed, since GC can happen while
2228 menus are active. */
2229 if (wv->help)
2230 info.dwItemData = (DWORD) wv->help;
2231
2232 if (wv->button_type == BUTTON_TYPE_RADIO)
2233 {
2234 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2235 RADIO items, but is not available on NT 3.51 and earlier. */
2236 info.fMask |= MIIM_TYPE | MIIM_STATE;
2237 info.fType = MFT_RADIOCHECK | MFT_STRING;
2238 info.dwTypeData = out_string;
2239 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2240 }
2241
2242 set_menu_item_info (menu,
2243 item != NULL ? (UINT) item : (UINT) wv->call_data,
2244 FALSE, &info);
2245 }
2246 }
2247 return return_value;
2248 }
2249
2250 /* Construct native Windows menu(bar) based on widget_value tree. */
2251 int
2252 fill_in_menu (HMENU menu, widget_value *wv)
2253 {
2254 int items_added = 0;
2255
2256 for ( ; wv != NULL; wv = wv->next)
2257 {
2258 if (wv->contents)
2259 {
2260 HMENU sub_menu = CreatePopupMenu ();
2261
2262 if (sub_menu == NULL)
2263 return 0;
2264
2265 if (!fill_in_menu (sub_menu, wv->contents) ||
2266 !add_menu_item (menu, wv, sub_menu))
2267 {
2268 DestroyMenu (sub_menu);
2269 return 0;
2270 }
2271 }
2272 else
2273 {
2274 if (!add_menu_item (menu, wv, NULL))
2275 return 0;
2276 }
2277 }
2278 return 1;
2279 }
2280
2281 int
2282 popup_activated ()
2283 {
2284 /* popup_activated_flag not actually used on W32 */
2285 return 0;
2286 }
2287
2288 /* Display help string for currently pointed to menu item. Not
2289 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2290 available. */
2291 void
2292 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2293 {
2294 if (get_menu_item_info)
2295 {
2296 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2297 Lisp_Object frame, help;
2298
2299 // No help echo on owner-draw menu items.
2300 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2301 help = Qnil;
2302 else
2303 {
2304 MENUITEMINFO info;
2305
2306 bzero (&info, sizeof (info));
2307 info.cbSize = sizeof (info);
2308 info.fMask = MIIM_DATA;
2309 get_menu_item_info (menu, item, FALSE, &info);
2310
2311 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2312 }
2313
2314 /* Store the help echo in the keyboard buffer as the X toolkit
2315 version does, rather than directly showing it. This seems to
2316 solve the GC problems that were present when we based the
2317 Windows code on the non-toolkit version. */
2318 if (f)
2319 {
2320 XSETFRAME (frame, f);
2321 kbd_buffer_store_help_event (frame, help);
2322 }
2323 else
2324 /* X version has a loop through frames here, which doesn't
2325 appear to do anything, unless it has some side effect. */
2326 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2327 }
2328 }
2329
2330 /* Free memory used by owner-drawn strings. */
2331 static void
2332 w32_free_submenu_strings (menu)
2333 HMENU menu;
2334 {
2335 int i, num = GetMenuItemCount (menu);
2336 for (i = 0; i < num; i++)
2337 {
2338 MENUITEMINFO info;
2339 bzero (&info, sizeof (info));
2340 info.cbSize = sizeof (info);
2341 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2342
2343 get_menu_item_info (menu, i, TRUE, &info);
2344
2345 /* Owner-drawn names are held in dwItemData. */
2346 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2347 {
2348 #ifdef MENU_DEBUG
2349 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2350 #endif
2351 local_free (info.dwItemData);
2352 }
2353
2354 /* Recurse down submenus. */
2355 if (info.hSubMenu)
2356 w32_free_submenu_strings (info.hSubMenu);
2357 }
2358 }
2359
2360 void
2361 w32_free_menu_strings (hwnd)
2362 HWND hwnd;
2363 {
2364 HMENU menu = current_popup_menu;
2365
2366 if (get_menu_item_info)
2367 {
2368 /* If there is no popup menu active, free the strings from the frame's
2369 menubar. */
2370 if (!menu)
2371 menu = GetMenu (hwnd);
2372
2373 if (menu)
2374 w32_free_submenu_strings (menu);
2375 }
2376
2377 current_popup_menu = NULL;
2378 }
2379
2380 #endif /* HAVE_MENUS */
2381
2382 void syms_of_w32menu ()
2383 {
2384 globals_of_w32menu ();
2385 staticpro (&menu_items);
2386 menu_items = Qnil;
2387
2388 current_popup_menu = NULL;
2389
2390 Qdebug_on_next_call = intern ("debug-on-next-call");
2391 staticpro (&Qdebug_on_next_call);
2392
2393 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2394 doc: /* Frame for which we are updating a menu.
2395 The enable predicate for a menu command should check this variable. */);
2396 Vmenu_updating_frame = Qnil;
2397
2398 defsubr (&Sx_popup_menu);
2399 #ifdef HAVE_MENUS
2400 defsubr (&Sx_popup_dialog);
2401 #endif
2402 }
2403
2404 /*
2405 globals_of_w32menu is used to initialize those global variables that
2406 must always be initialized on startup even when the global variable
2407 initialized is non zero (see the function main in emacs.c).
2408 globals_of_w32menu is called from syms_of_w32menu when the global
2409 variable initialized is 0 and directly from main when initialized
2410 is non zero.
2411 */
2412 void globals_of_w32menu ()
2413 {
2414 /* See if Get/SetMenuItemInfo functions are available. */
2415 HMODULE user32 = GetModuleHandle ("user32.dll");
2416 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2417 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2418 }