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