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