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