]> code.delx.au - gnu-emacs/blob - src/w32menu.c
(case table): Do nothing special for i and I.
[gnu-emacs] / src / w32menu.c
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2002, 2003,
3 2004, 2005, 2006 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22 #include <config.h>
23 #include <signal.h>
24
25 #include <stdio.h>
26 #include "lisp.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31 #include "window.h"
32 #include "blockinput.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "coding.h"
36
37 /* This may include sys/types.h, and that somehow loses
38 if this is not done before the other system files. */
39 #include "w32term.h"
40
41 /* Load sys/types.h if not already loaded.
42 In some systems loading it twice is suicidal. */
43 #ifndef makedev
44 #include <sys/types.h>
45 #endif
46
47 #include "dispextern.h"
48
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 Lisp_Object lname;
70 char* name;
71 /* value (meaning depend on widget type) */
72 char* value;
73 /* keyboard equivalent. no implications for XtTranslations */
74 Lisp_Object lkey;
75 char* key;
76 /* Help string or nil if none.
77 GC finds this string through the frame's menu_bar_vector
78 or through menu_items. */
79 Lisp_Object help;
80 /* true if enabled */
81 Boolean enabled;
82 /* true if selected */
83 Boolean selected;
84 /* The type of a button. */
85 enum button_type button_type;
86 /* true if menu title */
87 Boolean title;
88 #if 0
89 /* true if was edited (maintained by get_value) */
90 Boolean edited;
91 /* true if has changed (maintained by lw library) */
92 change_type change;
93 /* true if this widget itself has changed,
94 but not counting the other widgets found in the `next' field. */
95 change_type this_one_change;
96 #endif
97 /* Contents of the sub-widgets, also selected slot for checkbox */
98 struct _widget_value* contents;
99 /* data passed to callback */
100 XtPointer call_data;
101 /* next one in the list */
102 struct _widget_value* next;
103 #if 0
104 /* slot for the toolkit dependent part. Always initialize to NULL. */
105 void* toolkit_data;
106 /* tell us if we should free the toolkit data slot when freeing the
107 widget_value itself. */
108 Boolean free_toolkit_data;
109
110 /* we resource the widget_value structures; this points to the next
111 one on the free list if this one has been deallocated.
112 */
113 struct _widget_value *free_list;
114 #endif
115 } widget_value;
116
117 /* Local memory management */
118 #define local_heap (GetProcessHeap ())
119 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
120 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
121
122 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
123 #define free_widget_value(wv) (local_free ((wv)))
124
125 /******************************************************************/
126
127 #ifndef TRUE
128 #define TRUE 1
129 #define FALSE 0
130 #endif /* no TRUE */
131
132 static HMENU current_popup_menu;
133
134 void syms_of_w32menu ();
135 void globals_of_w32menu ();
136
137 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
138 IN HMENU,
139 IN UINT,
140 IN BOOL,
141 IN OUT LPMENUITEMINFOA);
142 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
143 IN HMENU,
144 IN UINT,
145 IN BOOL,
146 IN LPCMENUITEMINFOA);
147
148 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
149 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
150 AppendMenuW_Proc unicode_append_menu = NULL;
151
152 Lisp_Object Qdebug_on_next_call;
153
154 extern Lisp_Object Vmenu_updating_frame;
155
156 extern Lisp_Object Qmenu_bar;
157
158 extern Lisp_Object QCtoggle, QCradio;
159
160 extern Lisp_Object Voverriding_local_map;
161 extern Lisp_Object Voverriding_local_map_menu_flag;
162
163 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
164
165 extern Lisp_Object Qmenu_bar_update_hook;
166
167 void set_frame_menubar ();
168
169 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
170 Lisp_Object, Lisp_Object, Lisp_Object,
171 Lisp_Object, Lisp_Object));
172 #ifdef HAVE_DIALOGS
173 static Lisp_Object w32_dialog_show ();
174 #endif
175 static Lisp_Object w32_menu_show ();
176
177 static void keymap_panes ();
178 static void single_keymap_panes ();
179 static void single_menu_item ();
180 static void list_of_panes ();
181 static void list_of_items ();
182 void w32_free_menu_strings (HWND);
183 \f
184 /* This holds a Lisp vector that holds the results of decoding
185 the keymaps or alist-of-alists that specify a menu.
186
187 It describes the panes and items within the panes.
188
189 Each pane is described by 3 elements in the vector:
190 t, the pane name, the pane's prefix key.
191 Then follow the pane's items, with 5 elements per item:
192 the item string, the enable flag, the item's value,
193 the definition, and the equivalent keyboard key's description string.
194
195 In some cases, multiple levels of menus may be described.
196 A single vector slot containing nil indicates the start of a submenu.
197 A single vector slot containing lambda indicates the end of a submenu.
198 The submenu follows a menu item which is the way to reach the submenu.
199
200 A single vector slot containing quote indicates that the
201 following items should appear on the right of a dialog box.
202
203 Using a Lisp vector to hold this information while we decode it
204 takes care of protecting all the data from GC. */
205
206 #define MENU_ITEMS_PANE_NAME 1
207 #define MENU_ITEMS_PANE_PREFIX 2
208 #define MENU_ITEMS_PANE_LENGTH 3
209
210 enum menu_item_idx
211 {
212 MENU_ITEMS_ITEM_NAME = 0,
213 MENU_ITEMS_ITEM_ENABLE,
214 MENU_ITEMS_ITEM_VALUE,
215 MENU_ITEMS_ITEM_EQUIV_KEY,
216 MENU_ITEMS_ITEM_DEFINITION,
217 MENU_ITEMS_ITEM_TYPE,
218 MENU_ITEMS_ITEM_SELECTED,
219 MENU_ITEMS_ITEM_HELP,
220 MENU_ITEMS_ITEM_LENGTH
221 };
222
223 static Lisp_Object menu_items;
224
225 /* Number of slots currently allocated in menu_items. */
226 static int menu_items_allocated;
227
228 /* This is the index in menu_items of the first empty slot. */
229 static int menu_items_used;
230
231 /* The number of panes currently recorded in menu_items,
232 excluding those within submenus. */
233 static int menu_items_n_panes;
234
235 /* Current depth within submenus. */
236 static int menu_items_submenu_depth;
237
238 static int next_menubar_widget_id;
239
240 /* This is set nonzero after the user activates the menu bar, and set
241 to zero again after the menu bars are redisplayed by prepare_menu_bar.
242 While it is nonzero, all calls to set_frame_menubar go deep.
243
244 I don't understand why this is needed, but it does seem to be
245 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
246
247 int pending_menu_activation;
248 \f
249
250 /* Return the frame whose ->output_data.w32->menubar_widget equals
251 ID, or 0 if none. */
252
253 static struct frame *
254 menubar_id_to_frame (id)
255 HMENU id;
256 {
257 Lisp_Object tail, frame;
258 FRAME_PTR f;
259
260 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
261 {
262 frame = XCAR (tail);
263 if (!GC_FRAMEP (frame))
264 continue;
265 f = XFRAME (frame);
266 if (!FRAME_WINDOW_P (f))
267 continue;
268 if (f->output_data.w32->menubar_widget == id)
269 return f;
270 }
271 return 0;
272 }
273 \f
274 /* Initialize the menu_items structure if we haven't already done so.
275 Also mark it as currently empty. */
276
277 static void
278 init_menu_items ()
279 {
280 if (NILP (menu_items))
281 {
282 menu_items_allocated = 60;
283 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
284 }
285
286 menu_items_used = 0;
287 menu_items_n_panes = 0;
288 menu_items_submenu_depth = 0;
289 }
290
291 /* Call at the end of generating the data in menu_items.
292 This fills in the number of items in the last pane. */
293
294 static void
295 finish_menu_items ()
296 {
297 }
298
299 /* Call when finished using the data for the current menu
300 in menu_items. */
301
302 static void
303 discard_menu_items ()
304 {
305 /* Free the structure if it is especially large.
306 Otherwise, hold on to it, to save time. */
307 if (menu_items_allocated > 200)
308 {
309 menu_items = Qnil;
310 menu_items_allocated = 0;
311 }
312 }
313
314 /* Make the menu_items vector twice as large. */
315
316 static void
317 grow_menu_items ()
318 {
319 Lisp_Object old;
320 int old_size = menu_items_allocated;
321 old = menu_items;
322
323 menu_items_allocated *= 2;
324 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
325 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
326 old_size * sizeof (Lisp_Object));
327 }
328
329 /* Begin a submenu. */
330
331 static void
332 push_submenu_start ()
333 {
334 if (menu_items_used + 1 > menu_items_allocated)
335 grow_menu_items ();
336
337 ASET (menu_items, menu_items_used++, Qnil);
338 menu_items_submenu_depth++;
339 }
340
341 /* End a submenu. */
342
343 static void
344 push_submenu_end ()
345 {
346 if (menu_items_used + 1 > menu_items_allocated)
347 grow_menu_items ();
348
349 ASET (menu_items, menu_items_used++, Qlambda);
350 menu_items_submenu_depth--;
351 }
352
353 /* Indicate boundary between left and right. */
354
355 static void
356 push_left_right_boundary ()
357 {
358 if (menu_items_used + 1 > menu_items_allocated)
359 grow_menu_items ();
360
361 ASET (menu_items, menu_items_used++, Qquote);
362 }
363
364 /* Start a new menu pane in menu_items.
365 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
366
367 static void
368 push_menu_pane (name, prefix_vec)
369 Lisp_Object name, prefix_vec;
370 {
371 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
372 grow_menu_items ();
373
374 if (menu_items_submenu_depth == 0)
375 menu_items_n_panes++;
376 ASET (menu_items, menu_items_used++, Qt);
377 ASET (menu_items, menu_items_used++, name);
378 ASET (menu_items, menu_items_used++, prefix_vec);
379 }
380
381 /* Push one menu item into the current pane. NAME is the string to
382 display. ENABLE if non-nil means this item can be selected. KEY
383 is the key generated by choosing this item, or nil if this item
384 doesn't really have a definition. DEF is the definition of this
385 item. EQUIV is the textual description of the keyboard equivalent
386 for this item (or nil if none). TYPE is the type of this menu
387 item, one of nil, `toggle' or `radio'. */
388
389 static void
390 push_menu_item (name, enable, key, def, equiv, type, selected, help)
391 Lisp_Object name, enable, key, def, equiv, type, selected, help;
392 {
393 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
394 grow_menu_items ();
395
396 ASET (menu_items, menu_items_used++, name);
397 ASET (menu_items, menu_items_used++, enable);
398 ASET (menu_items, menu_items_used++, key);
399 ASET (menu_items, menu_items_used++, equiv);
400 ASET (menu_items, menu_items_used++, def);
401 ASET (menu_items, menu_items_used++, type);
402 ASET (menu_items, menu_items_used++, selected);
403 ASET (menu_items, menu_items_used++, help);
404 }
405 \f
406 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
407 and generate menu panes for them in menu_items.
408 If NOTREAL is nonzero,
409 don't bother really computing whether an item is enabled. */
410
411 static void
412 keymap_panes (keymaps, nmaps, notreal)
413 Lisp_Object *keymaps;
414 int nmaps;
415 int notreal;
416 {
417 int mapno;
418
419 init_menu_items ();
420
421 /* Loop over the given keymaps, making a pane for each map.
422 But don't make a pane that is empty--ignore that map instead.
423 P is the number of panes we have made so far. */
424 for (mapno = 0; mapno < nmaps; mapno++)
425 single_keymap_panes (keymaps[mapno],
426 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
427
428 finish_menu_items ();
429 }
430
431 /* This is a recursive subroutine of keymap_panes.
432 It handles one keymap, KEYMAP.
433 The other arguments are passed along
434 or point to local variables of the previous function.
435 If NOTREAL is nonzero, only check for equivalent key bindings, don't
436 evaluate expressions in menu items and don't make any menu.
437
438 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
439
440 static void
441 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
442 Lisp_Object keymap;
443 Lisp_Object pane_name;
444 Lisp_Object prefix;
445 int notreal;
446 int maxdepth;
447 {
448 Lisp_Object pending_maps = Qnil;
449 Lisp_Object tail, item;
450 struct gcpro gcpro1, gcpro2;
451
452 if (maxdepth <= 0)
453 return;
454
455 push_menu_pane (pane_name, prefix);
456
457 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
458 {
459 GCPRO2 (keymap, pending_maps);
460 /* Look at each key binding, and if it is a menu item add it
461 to this menu. */
462 item = XCAR (tail);
463 if (CONSP (item))
464 single_menu_item (XCAR (item), XCDR (item),
465 &pending_maps, notreal, maxdepth);
466 else if (VECTORP (item))
467 {
468 /* Loop over the char values represented in the vector. */
469 int len = ASIZE (item);
470 int c;
471 for (c = 0; c < len; c++)
472 {
473 Lisp_Object character;
474 XSETFASTINT (character, c);
475 single_menu_item (character, AREF (item, c),
476 &pending_maps, notreal, maxdepth);
477 }
478 }
479 UNGCPRO;
480 }
481
482 /* Process now any submenus which want to be panes at this level. */
483 while (!NILP (pending_maps))
484 {
485 Lisp_Object elt, eltcdr, string;
486 elt = Fcar (pending_maps);
487 eltcdr = XCDR (elt);
488 string = XCAR (eltcdr);
489 /* We no longer discard the @ from the beginning of the string here.
490 Instead, we do this in w32_menu_show. */
491 single_keymap_panes (Fcar (elt), string,
492 XCDR (eltcdr), notreal, maxdepth - 1);
493 pending_maps = Fcdr (pending_maps);
494 }
495 }
496 \f
497 /* This is a subroutine of single_keymap_panes that handles one
498 keymap entry.
499 KEY is a key in a keymap and ITEM is its binding.
500 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
501 separate panes.
502 If NOTREAL is nonzero, only check for equivalent key bindings, don't
503 evaluate expressions in menu items and don't make any menu.
504 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
505
506 static void
507 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
508 Lisp_Object key, item;
509 Lisp_Object *pending_maps_ptr;
510 int maxdepth, notreal;
511 {
512 Lisp_Object map, item_string, enabled;
513 struct gcpro gcpro1, gcpro2;
514 int res;
515
516 /* Parse the menu item and leave the result in item_properties. */
517 GCPRO2 (key, item);
518 res = parse_menu_item (item, notreal, 0);
519 UNGCPRO;
520 if (!res)
521 return; /* Not a menu item. */
522
523 map = AREF (item_properties, ITEM_PROPERTY_MAP);
524
525 if (notreal)
526 {
527 /* We don't want to make a menu, just traverse the keymaps to
528 precompute equivalent key bindings. */
529 if (!NILP (map))
530 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
531 return;
532 }
533
534 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
535 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
536
537 if (!NILP (map) && SREF (item_string, 0) == '@')
538 {
539 if (!NILP (enabled))
540 /* An enabled separate pane. Remember this to handle it later. */
541 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
542 *pending_maps_ptr);
543 return;
544 }
545
546 push_menu_item (item_string, enabled, key,
547 AREF (item_properties, ITEM_PROPERTY_DEF),
548 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
549 AREF (item_properties, ITEM_PROPERTY_TYPE),
550 AREF (item_properties, ITEM_PROPERTY_SELECTED),
551 AREF (item_properties, ITEM_PROPERTY_HELP));
552
553 /* Display a submenu using the toolkit. */
554 if (! (NILP (map) || NILP (enabled)))
555 {
556 push_submenu_start ();
557 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
558 push_submenu_end ();
559 }
560 }
561 \f
562 /* Push all the panes and items of a menu described by the
563 alist-of-alists MENU.
564 This handles old-fashioned calls to x-popup-menu. */
565
566 static void
567 list_of_panes (menu)
568 Lisp_Object menu;
569 {
570 Lisp_Object tail;
571
572 init_menu_items ();
573
574 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
575 {
576 Lisp_Object elt, pane_name, pane_data;
577 elt = Fcar (tail);
578 pane_name = Fcar (elt);
579 CHECK_STRING (pane_name);
580 push_menu_pane (pane_name, Qnil);
581 pane_data = Fcdr (elt);
582 CHECK_CONS (pane_data);
583 list_of_items (pane_data);
584 }
585
586 finish_menu_items ();
587 }
588
589 /* Push the items in a single pane defined by the alist PANE. */
590
591 static void
592 list_of_items (pane)
593 Lisp_Object pane;
594 {
595 Lisp_Object tail, item, item1;
596
597 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
598 {
599 item = Fcar (tail);
600 if (STRINGP (item))
601 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
602 else if (NILP (item))
603 push_left_right_boundary ();
604 else
605 {
606 CHECK_CONS (item);
607 item1 = Fcar (item);
608 CHECK_STRING (item1);
609 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
610 }
611 }
612 }
613 \f
614 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
615 doc: /* Pop up a deck-of-cards menu and return user's selection.
616 POSITION is a position specification. This is either a mouse button
617 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
618 are positions in pixels from the top left corner of WINDOW's frame
619 \(WINDOW may be a frame object instead of a window). This controls the
620 position of the center of the first line in the first pane of the
621 menu, not the top left of the menu as a whole. If POSITION is t, it
622 means to use the current mouse position.
623
624 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
625 The menu items come from key bindings that have a menu string as well as
626 a definition; actually, the \"definition\" in such a key binding looks like
627 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
628 the keymap as a top-level element.
629
630 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
631 Otherwise, REAL-DEFINITION should be a valid key binding definition.
632
633 You can also use a list of keymaps as MENU. Then each keymap makes a
634 separate pane. When MENU is a keymap or a list of keymaps, the return
635 value is a list of events.
636
637 Alternatively, you can specify a menu of multiple panes with a list of
638 the form (TITLE PANE1 PANE2...), where each pane is a list of
639 form (TITLE ITEM1 ITEM2...).
640 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
641 appear as an item--that makes a nonselectable line in the menu.
642 With this form of menu, the return value is VALUE from the chosen item.
643
644 If POSITION is nil, don't display the menu at all, just precalculate the
645 cached information about equivalent key sequences. */)
646 (position, menu)
647 Lisp_Object position, menu;
648 {
649 Lisp_Object keymap, tem;
650 int xpos = 0, ypos = 0;
651 Lisp_Object title;
652 char *error_name;
653 Lisp_Object selection;
654 FRAME_PTR f = NULL;
655 Lisp_Object x, y, window;
656 int keymaps = 0;
657 int for_click = 0;
658 struct gcpro gcpro1;
659
660 #ifdef HAVE_MENUS
661 if (! NILP (position))
662 {
663 check_w32 ();
664
665 /* Decode the first argument: find the window and the coordinates. */
666 if (EQ (position, Qt)
667 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
668 || EQ (XCAR (position), Qtool_bar))))
669 {
670 /* Use the mouse's current position. */
671 FRAME_PTR new_f = SELECTED_FRAME ();
672 Lisp_Object bar_window;
673 enum scroll_bar_part part;
674 unsigned long time;
675
676 if (mouse_position_hook)
677 (*mouse_position_hook) (&new_f, 1, &bar_window,
678 &part, &x, &y, &time);
679 if (new_f != 0)
680 XSETFRAME (window, new_f);
681 else
682 {
683 window = selected_window;
684 XSETFASTINT (x, 0);
685 XSETFASTINT (y, 0);
686 }
687 }
688 else
689 {
690 tem = Fcar (position);
691 if (CONSP (tem))
692 {
693 window = Fcar (Fcdr (position));
694 x = Fcar (tem);
695 y = Fcar (Fcdr (tem));
696 }
697 else
698 {
699 for_click = 1;
700 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
701 window = Fcar (tem); /* POSN_WINDOW (tem) */
702 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
703 x = Fcar (tem);
704 y = Fcdr (tem);
705 }
706 }
707
708 CHECK_NUMBER (x);
709 CHECK_NUMBER (y);
710
711 /* Decode where to put the menu. */
712
713 if (FRAMEP (window))
714 {
715 f = XFRAME (window);
716 xpos = 0;
717 ypos = 0;
718 }
719 else if (WINDOWP (window))
720 {
721 CHECK_LIVE_WINDOW (window);
722 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
723
724 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
725 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
726 }
727 else
728 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
729 but I don't want to make one now. */
730 CHECK_WINDOW (window);
731
732 xpos += XINT (x);
733 ypos += XINT (y);
734
735 XSETFRAME (Vmenu_updating_frame, f);
736 }
737 else
738 Vmenu_updating_frame = Qnil;
739 #endif /* HAVE_MENUS */
740
741 title = Qnil;
742 GCPRO1 (title);
743
744 /* Decode the menu items from what was specified. */
745
746 keymap = get_keymap (menu, 0, 0);
747 if (CONSP (keymap))
748 {
749 /* We were given a keymap. Extract menu info from the keymap. */
750 Lisp_Object prompt;
751
752 /* Extract the detailed info to make one pane. */
753 keymap_panes (&menu, 1, NILP (position));
754
755 /* Search for a string appearing directly as an element of the keymap.
756 That string is the title of the menu. */
757 prompt = Fkeymap_prompt (keymap);
758 if (NILP (title) && !NILP (prompt))
759 title = prompt;
760
761 /* Make that be the pane title of the first pane. */
762 if (!NILP (prompt) && menu_items_n_panes >= 0)
763 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
764
765 keymaps = 1;
766 }
767 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
768 {
769 /* We were given a list of keymaps. */
770 int nmaps = XFASTINT (Flength (menu));
771 Lisp_Object *maps
772 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
773 int i;
774
775 title = Qnil;
776
777 /* The first keymap that has a prompt string
778 supplies the menu title. */
779 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
780 {
781 Lisp_Object prompt;
782
783 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
784
785 prompt = Fkeymap_prompt (keymap);
786 if (NILP (title) && !NILP (prompt))
787 title = prompt;
788 }
789
790 /* Extract the detailed info to make one pane. */
791 keymap_panes (maps, nmaps, NILP (position));
792
793 /* Make the title be the pane title of the first pane. */
794 if (!NILP (title) && menu_items_n_panes >= 0)
795 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
796
797 keymaps = 1;
798 }
799 else
800 {
801 /* We were given an old-fashioned menu. */
802 title = Fcar (menu);
803 CHECK_STRING (title);
804
805 list_of_panes (Fcdr (menu));
806
807 keymaps = 0;
808 }
809
810 if (NILP (position))
811 {
812 discard_menu_items ();
813 UNGCPRO;
814 return Qnil;
815 }
816
817 #ifdef HAVE_MENUS
818 /* If resources from a previous popup menu still exist, does nothing
819 until the `menu_free_timer' has freed them (see w32fns.c). This
820 can occur if you press ESC or click outside a menu without selecting
821 a menu item.
822 */
823 if (current_popup_menu)
824 {
825 discard_menu_items ();
826 UNGCPRO;
827 return Qnil;
828 }
829
830 /* Display them in a menu. */
831 BLOCK_INPUT;
832
833 selection = w32_menu_show (f, xpos, ypos, for_click,
834 keymaps, title, &error_name);
835 UNBLOCK_INPUT;
836
837 discard_menu_items ();
838 w32_free_menu_strings (FRAME_W32_WINDOW (f));
839
840 #endif /* HAVE_MENUS */
841
842 UNGCPRO;
843
844 if (error_name) error (error_name);
845 return selection;
846 }
847
848 #ifdef HAVE_MENUS
849
850 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
851 doc: /* Pop up a dialog box and return user's selection.
852 POSITION specifies which frame to use.
853 This is normally a mouse button event or a window or frame.
854 If POSITION is t, it means to use the frame the mouse is on.
855 The dialog box appears in the middle of the specified frame.
856
857 CONTENTS specifies the alternatives to display in the dialog box.
858 It is a list of the form (TITLE ITEM1 ITEM2...).
859 Each ITEM is a cons cell (STRING . VALUE).
860 The return value is VALUE from the chosen item.
861
862 An ITEM may also be just a string--that makes a nonselectable item.
863 An ITEM may also be nil--that means to put all preceding items
864 on the left of the dialog box and all following items on the right.
865 \(By default, approximately half appear on each side.)
866
867 If HEADER is non-nil, the frame title for the box is "Information",
868 otherwise it is "Question". */)
869 (position, contents, header)
870 Lisp_Object position, contents, header;
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, header, &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_save_match_data ();
1449
1450 if (NILP (Voverriding_local_map_menu_flag))
1451 {
1452 specbind (Qoverriding_terminal_local_map, Qnil);
1453 specbind (Qoverriding_local_map, Qnil);
1454 }
1455
1456 set_buffer_internal_1 (XBUFFER (buffer));
1457
1458 /* Run the Lucid hook. */
1459 safe_run_hooks (Qactivate_menubar_hook);
1460 /* If it has changed current-menubar from previous value,
1461 really recompute the menubar from the value. */
1462 if (! NILP (Vlucid_menu_bar_dirty_flag))
1463 call0 (Qrecompute_lucid_menubar);
1464 safe_run_hooks (Qmenu_bar_update_hook);
1465 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1466
1467 items = FRAME_MENU_BAR_ITEMS (f);
1468
1469 /* Save the frame's previous menu bar contents data. */
1470 if (previous_menu_items_used)
1471 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1472 previous_menu_items_used * sizeof (Lisp_Object));
1473
1474 /* Fill in menu_items with the current menu bar contents.
1475 This can evaluate Lisp code. */
1476 menu_items = f->menu_bar_vector;
1477 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1478 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1479 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1480 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1481 submenu_top_level_items
1482 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1483 init_menu_items ();
1484 for (i = 0; i < ASIZE (items); i += 4)
1485 {
1486 Lisp_Object key, string, maps;
1487
1488 last_i = i;
1489
1490 key = AREF (items, i);
1491 string = AREF (items, i + 1);
1492 maps = AREF (items, i + 2);
1493 if (NILP (string))
1494 break;
1495
1496 submenu_start[i] = menu_items_used;
1497
1498 menu_items_n_panes = 0;
1499 submenu_top_level_items[i]
1500 = parse_single_submenu (key, string, maps);
1501 submenu_n_panes[i] = menu_items_n_panes;
1502
1503 submenu_end[i] = menu_items_used;
1504 }
1505
1506 finish_menu_items ();
1507
1508 /* Convert menu_items into widget_value trees
1509 to display the menu. This cannot evaluate Lisp code. */
1510
1511 wv = xmalloc_widget_value ();
1512 wv->name = "menubar";
1513 wv->value = 0;
1514 wv->enabled = 1;
1515 wv->button_type = BUTTON_TYPE_NONE;
1516 wv->help = Qnil;
1517 first_wv = wv;
1518
1519 for (i = 0; i < last_i; i += 4)
1520 {
1521 menu_items_n_panes = submenu_n_panes[i];
1522 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1523 submenu_top_level_items[i]);
1524 if (prev_wv)
1525 prev_wv->next = wv;
1526 else
1527 first_wv->contents = wv;
1528 /* Don't set wv->name here; GC during the loop might relocate it. */
1529 wv->enabled = 1;
1530 wv->button_type = BUTTON_TYPE_NONE;
1531 prev_wv = wv;
1532 }
1533
1534 set_buffer_internal_1 (prev);
1535 unbind_to (specpdl_count, Qnil);
1536
1537 /* If there has been no change in the Lisp-level contents
1538 of the menu bar, skip redisplaying it. Just exit. */
1539
1540 for (i = 0; i < previous_menu_items_used; i++)
1541 if (menu_items_used == i
1542 || (!EQ (previous_items[i], AREF (menu_items, i))))
1543 break;
1544 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1545 {
1546 free_menubar_widget_value_tree (first_wv);
1547 menu_items = Qnil;
1548
1549 return;
1550 }
1551
1552 /* Now GC cannot happen during the lifetime of the widget_value,
1553 so it's safe to store data from a Lisp_String, as long as
1554 local copies are made when the actual menu is created.
1555 Windows takes care of this for normal string items, but
1556 not for owner-drawn items or additional item-info. */
1557 wv = first_wv->contents;
1558 for (i = 0; i < ASIZE (items); i += 4)
1559 {
1560 Lisp_Object string;
1561 string = AREF (items, i + 1);
1562 if (NILP (string))
1563 break;
1564 wv->name = (char *) SDATA (string);
1565 update_submenu_strings (wv->contents);
1566 wv = wv->next;
1567 }
1568
1569 f->menu_bar_vector = menu_items;
1570 f->menu_bar_items_used = menu_items_used;
1571 menu_items = Qnil;
1572 }
1573 else
1574 {
1575 /* Make a widget-value tree containing
1576 just the top level menu bar strings. */
1577
1578 wv = xmalloc_widget_value ();
1579 wv->name = "menubar";
1580 wv->value = 0;
1581 wv->enabled = 1;
1582 wv->button_type = BUTTON_TYPE_NONE;
1583 wv->help = Qnil;
1584 first_wv = wv;
1585
1586 items = FRAME_MENU_BAR_ITEMS (f);
1587 for (i = 0; i < ASIZE (items); i += 4)
1588 {
1589 Lisp_Object string;
1590
1591 string = AREF (items, i + 1);
1592 if (NILP (string))
1593 break;
1594
1595 wv = xmalloc_widget_value ();
1596 wv->name = (char *) SDATA (string);
1597 wv->value = 0;
1598 wv->enabled = 1;
1599 wv->button_type = BUTTON_TYPE_NONE;
1600 wv->help = Qnil;
1601 /* This prevents lwlib from assuming this
1602 menu item is really supposed to be empty. */
1603 /* The EMACS_INT cast avoids a warning.
1604 This value just has to be different from small integers. */
1605 wv->call_data = (void *) (EMACS_INT) (-1);
1606
1607 if (prev_wv)
1608 prev_wv->next = wv;
1609 else
1610 first_wv->contents = wv;
1611 prev_wv = wv;
1612 }
1613
1614 /* Forget what we thought we knew about what is in the
1615 detailed contents of the menu bar menus.
1616 Changing the top level always destroys the contents. */
1617 f->menu_bar_items_used = 0;
1618 }
1619
1620 /* Create or update the menu bar widget. */
1621
1622 BLOCK_INPUT;
1623
1624 if (menubar_widget)
1625 {
1626 /* Empty current menubar, rather than creating a fresh one. */
1627 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1628 ;
1629 }
1630 else
1631 {
1632 menubar_widget = CreateMenu ();
1633 }
1634 fill_in_menu (menubar_widget, first_wv->contents);
1635
1636 free_menubar_widget_value_tree (first_wv);
1637
1638 {
1639 HMENU old_widget = f->output_data.w32->menubar_widget;
1640
1641 f->output_data.w32->menubar_widget = menubar_widget;
1642 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1643 /* Causes flicker when menu bar is updated
1644 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1645
1646 /* Force the window size to be recomputed so that the frame's text
1647 area remains the same, if menubar has just been created. */
1648 if (old_widget == NULL)
1649 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1650 }
1651
1652 UNBLOCK_INPUT;
1653 }
1654
1655 /* Called from Fx_create_frame to create the initial menubar of a frame
1656 before it is mapped, so that the window is mapped with the menubar already
1657 there instead of us tacking it on later and thrashing the window after it
1658 is visible. */
1659
1660 void
1661 initialize_frame_menubar (f)
1662 FRAME_PTR f;
1663 {
1664 /* This function is called before the first chance to redisplay
1665 the frame. It has to be, so the frame will have the right size. */
1666 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1667 set_frame_menubar (f, 1, 1);
1668 }
1669
1670 /* Get rid of the menu bar of frame F, and free its storage.
1671 This is used when deleting a frame, and when turning off the menu bar. */
1672
1673 void
1674 free_frame_menubar (f)
1675 FRAME_PTR f;
1676 {
1677 BLOCK_INPUT;
1678
1679 {
1680 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1681 SetMenu (FRAME_W32_WINDOW (f), NULL);
1682 f->output_data.w32->menubar_widget = NULL;
1683 DestroyMenu (old);
1684 }
1685
1686 UNBLOCK_INPUT;
1687 }
1688
1689 \f
1690 /* w32_menu_show actually displays a menu using the panes and items in
1691 menu_items and returns the value selected from it; we assume input
1692 is blocked by the caller. */
1693
1694 /* F is the frame the menu is for.
1695 X and Y are the frame-relative specified position,
1696 relative to the inside upper left corner of the frame F.
1697 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1698 KEYMAPS is 1 if this menu was specified with keymaps;
1699 in that case, we return a list containing the chosen item's value
1700 and perhaps also the pane's prefix.
1701 TITLE is the specified menu title.
1702 ERROR is a place to store an error message string in case of failure.
1703 (We return nil on failure, but the value doesn't actually matter.) */
1704
1705 static Lisp_Object
1706 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1707 FRAME_PTR f;
1708 int x;
1709 int y;
1710 int for_click;
1711 int keymaps;
1712 Lisp_Object title;
1713 char **error;
1714 {
1715 int i;
1716 int menu_item_selection;
1717 HMENU menu;
1718 POINT pos;
1719 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1720 widget_value **submenu_stack
1721 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1722 Lisp_Object *subprefix_stack
1723 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1724 int submenu_depth = 0;
1725 int first_pane;
1726
1727 *error = NULL;
1728
1729 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1730 {
1731 *error = "Empty menu";
1732 return Qnil;
1733 }
1734
1735 /* Create a tree of widget_value objects
1736 representing the panes and their items. */
1737 wv = xmalloc_widget_value ();
1738 wv->name = "menu";
1739 wv->value = 0;
1740 wv->enabled = 1;
1741 wv->button_type = BUTTON_TYPE_NONE;
1742 wv->help = Qnil;
1743 first_wv = wv;
1744 first_pane = 1;
1745
1746 /* Loop over all panes and items, filling in the tree. */
1747 i = 0;
1748 while (i < menu_items_used)
1749 {
1750 if (EQ (AREF (menu_items, i), Qnil))
1751 {
1752 submenu_stack[submenu_depth++] = save_wv;
1753 save_wv = prev_wv;
1754 prev_wv = 0;
1755 first_pane = 1;
1756 i++;
1757 }
1758 else if (EQ (AREF (menu_items, i), Qlambda))
1759 {
1760 prev_wv = save_wv;
1761 save_wv = submenu_stack[--submenu_depth];
1762 first_pane = 0;
1763 i++;
1764 }
1765 else if (EQ (AREF (menu_items, i), Qt)
1766 && submenu_depth != 0)
1767 i += MENU_ITEMS_PANE_LENGTH;
1768 /* Ignore a nil in the item list.
1769 It's meaningful only for dialog boxes. */
1770 else if (EQ (AREF (menu_items, i), Qquote))
1771 i += 1;
1772 else if (EQ (AREF (menu_items, i), Qt))
1773 {
1774 /* Create a new pane. */
1775 Lisp_Object pane_name, prefix;
1776 char *pane_string;
1777 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1778 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1779
1780 if (STRINGP (pane_name))
1781 {
1782 if (unicode_append_menu)
1783 pane_name = ENCODE_UTF_8 (pane_name);
1784 else if (STRING_MULTIBYTE (pane_name))
1785 pane_name = ENCODE_SYSTEM (pane_name);
1786
1787 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1788 }
1789
1790 pane_string = (NILP (pane_name)
1791 ? "" : (char *) SDATA (pane_name));
1792 /* If there is just one top-level pane, put all its items directly
1793 under the top-level menu. */
1794 if (menu_items_n_panes == 1)
1795 pane_string = "";
1796
1797 /* If the pane has a meaningful name,
1798 make the pane a top-level menu item
1799 with its items as a submenu beneath it. */
1800 if (!keymaps && strcmp (pane_string, ""))
1801 {
1802 wv = xmalloc_widget_value ();
1803 if (save_wv)
1804 save_wv->next = wv;
1805 else
1806 first_wv->contents = wv;
1807 wv->name = pane_string;
1808 if (keymaps && !NILP (prefix))
1809 wv->name++;
1810 wv->value = 0;
1811 wv->enabled = 1;
1812 wv->button_type = BUTTON_TYPE_NONE;
1813 wv->help = Qnil;
1814 save_wv = wv;
1815 prev_wv = 0;
1816 }
1817 else if (first_pane)
1818 {
1819 save_wv = wv;
1820 prev_wv = 0;
1821 }
1822 first_pane = 0;
1823 i += MENU_ITEMS_PANE_LENGTH;
1824 }
1825 else
1826 {
1827 /* Create a new item within current pane. */
1828 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1829
1830 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1831 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1832 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1833 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1834 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1835 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1836 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1837
1838 if (STRINGP (item_name))
1839 {
1840 if (unicode_append_menu)
1841 item_name = ENCODE_UTF_8 (item_name);
1842 else if (STRING_MULTIBYTE (item_name))
1843 item_name = ENCODE_SYSTEM (item_name);
1844
1845 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1846 }
1847
1848 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1849 {
1850 descrip = ENCODE_SYSTEM (descrip);
1851 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1852 }
1853
1854 wv = xmalloc_widget_value ();
1855 if (prev_wv)
1856 prev_wv->next = wv;
1857 else
1858 save_wv->contents = wv;
1859 wv->name = (char *) SDATA (item_name);
1860 if (!NILP (descrip))
1861 wv->key = (char *) SDATA (descrip);
1862 wv->value = 0;
1863 /* Use the contents index as call_data, since we are
1864 restricted to 16-bits. */
1865 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1866 wv->enabled = !NILP (enable);
1867
1868 if (NILP (type))
1869 wv->button_type = BUTTON_TYPE_NONE;
1870 else if (EQ (type, QCtoggle))
1871 wv->button_type = BUTTON_TYPE_TOGGLE;
1872 else if (EQ (type, QCradio))
1873 wv->button_type = BUTTON_TYPE_RADIO;
1874 else
1875 abort ();
1876
1877 wv->selected = !NILP (selected);
1878 if (!STRINGP (help))
1879 help = Qnil;
1880
1881 wv->help = help;
1882
1883 prev_wv = wv;
1884
1885 i += MENU_ITEMS_ITEM_LENGTH;
1886 }
1887 }
1888
1889 /* Deal with the title, if it is non-nil. */
1890 if (!NILP (title))
1891 {
1892 widget_value *wv_title = xmalloc_widget_value ();
1893 widget_value *wv_sep = xmalloc_widget_value ();
1894
1895 /* Maybe replace this separator with a bitmap or owner-draw item
1896 so that it looks better. Having two separators looks odd. */
1897 wv_sep->name = "--";
1898 wv_sep->next = first_wv->contents;
1899 wv_sep->help = Qnil;
1900
1901 if (unicode_append_menu)
1902 title = ENCODE_UTF_8 (title);
1903 else if (STRING_MULTIBYTE (title))
1904 title = ENCODE_SYSTEM (title);
1905
1906 wv_title->name = (char *) SDATA (title);
1907 wv_title->enabled = TRUE;
1908 wv_title->title = TRUE;
1909 wv_title->button_type = BUTTON_TYPE_NONE;
1910 wv_title->help = Qnil;
1911 wv_title->next = wv_sep;
1912 first_wv->contents = wv_title;
1913 }
1914
1915 /* Actually create the menu. */
1916 current_popup_menu = menu = CreatePopupMenu ();
1917 fill_in_menu (menu, first_wv->contents);
1918
1919 /* Adjust coordinates to be root-window-relative. */
1920 pos.x = x;
1921 pos.y = y;
1922 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1923
1924 /* No selection has been chosen yet. */
1925 menu_item_selection = 0;
1926
1927 /* Display the menu. */
1928 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1929 WM_EMACS_TRACKPOPUPMENU,
1930 (WPARAM)menu, (LPARAM)&pos);
1931
1932 /* Clean up extraneous mouse events which might have been generated
1933 during the call. */
1934 discard_mouse_events ();
1935
1936 /* Free the widget_value objects we used to specify the contents. */
1937 free_menubar_widget_value_tree (first_wv);
1938
1939 DestroyMenu (menu);
1940
1941 /* Find the selected item, and its pane, to return
1942 the proper value. */
1943 if (menu_item_selection != 0)
1944 {
1945 Lisp_Object prefix, entry;
1946
1947 prefix = entry = Qnil;
1948 i = 0;
1949 while (i < menu_items_used)
1950 {
1951 if (EQ (AREF (menu_items, i), Qnil))
1952 {
1953 subprefix_stack[submenu_depth++] = prefix;
1954 prefix = entry;
1955 i++;
1956 }
1957 else if (EQ (AREF (menu_items, i), Qlambda))
1958 {
1959 prefix = subprefix_stack[--submenu_depth];
1960 i++;
1961 }
1962 else if (EQ (AREF (menu_items, i), Qt))
1963 {
1964 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1965 i += MENU_ITEMS_PANE_LENGTH;
1966 }
1967 /* Ignore a nil in the item list.
1968 It's meaningful only for dialog boxes. */
1969 else if (EQ (AREF (menu_items, i), Qquote))
1970 i += 1;
1971 else
1972 {
1973 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1974 if (menu_item_selection == i)
1975 {
1976 if (keymaps != 0)
1977 {
1978 int j;
1979
1980 entry = Fcons (entry, Qnil);
1981 if (!NILP (prefix))
1982 entry = Fcons (prefix, entry);
1983 for (j = submenu_depth - 1; j >= 0; j--)
1984 if (!NILP (subprefix_stack[j]))
1985 entry = Fcons (subprefix_stack[j], entry);
1986 }
1987 return entry;
1988 }
1989 i += MENU_ITEMS_ITEM_LENGTH;
1990 }
1991 }
1992 }
1993 else if (!for_click)
1994 /* Make "Cancel" equivalent to C-g. */
1995 Fsignal (Qquit, Qnil);
1996
1997 return Qnil;
1998 }
1999 \f
2000
2001 #ifdef HAVE_DIALOGS
2002 static char * button_names [] = {
2003 "button1", "button2", "button3", "button4", "button5",
2004 "button6", "button7", "button8", "button9", "button10" };
2005
2006 static Lisp_Object
2007 w32_dialog_show (f, keymaps, title, header, error)
2008 FRAME_PTR f;
2009 int keymaps;
2010 Lisp_Object title, header;
2011 char **error;
2012 {
2013 int i, nb_buttons=0;
2014 char dialog_name[6];
2015 int menu_item_selection;
2016
2017 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2018
2019 /* Number of elements seen so far, before boundary. */
2020 int left_count = 0;
2021 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2022 int boundary_seen = 0;
2023
2024 *error = NULL;
2025
2026 if (menu_items_n_panes > 1)
2027 {
2028 *error = "Multiple panes in dialog box";
2029 return Qnil;
2030 }
2031
2032 /* Create a tree of widget_value objects
2033 representing the text label and buttons. */
2034 {
2035 Lisp_Object pane_name, prefix;
2036 char *pane_string;
2037 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2038 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2039 pane_string = (NILP (pane_name)
2040 ? "" : (char *) SDATA (pane_name));
2041 prev_wv = xmalloc_widget_value ();
2042 prev_wv->value = pane_string;
2043 if (keymaps && !NILP (prefix))
2044 prev_wv->name++;
2045 prev_wv->enabled = 1;
2046 prev_wv->name = "message";
2047 prev_wv->help = Qnil;
2048 first_wv = prev_wv;
2049
2050 /* Loop over all panes and items, filling in the tree. */
2051 i = MENU_ITEMS_PANE_LENGTH;
2052 while (i < menu_items_used)
2053 {
2054
2055 /* Create a new item within current pane. */
2056 Lisp_Object item_name, enable, descrip, help;
2057
2058 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2059 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2060 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2061 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2062
2063 if (NILP (item_name))
2064 {
2065 free_menubar_widget_value_tree (first_wv);
2066 *error = "Submenu in dialog items";
2067 return Qnil;
2068 }
2069 if (EQ (item_name, Qquote))
2070 {
2071 /* This is the boundary between left-side elts
2072 and right-side elts. Stop incrementing right_count. */
2073 boundary_seen = 1;
2074 i++;
2075 continue;
2076 }
2077 if (nb_buttons >= 9)
2078 {
2079 free_menubar_widget_value_tree (first_wv);
2080 *error = "Too many dialog items";
2081 return Qnil;
2082 }
2083
2084 wv = xmalloc_widget_value ();
2085 prev_wv->next = wv;
2086 wv->name = (char *) button_names[nb_buttons];
2087 if (!NILP (descrip))
2088 wv->key = (char *) SDATA (descrip);
2089 wv->value = (char *) SDATA (item_name);
2090 wv->call_data = (void *) &AREF (menu_items, i);
2091 wv->enabled = !NILP (enable);
2092 wv->help = Qnil;
2093 prev_wv = wv;
2094
2095 if (! boundary_seen)
2096 left_count++;
2097
2098 nb_buttons++;
2099 i += MENU_ITEMS_ITEM_LENGTH;
2100 }
2101
2102 /* If the boundary was not specified,
2103 by default put half on the left and half on the right. */
2104 if (! boundary_seen)
2105 left_count = nb_buttons - nb_buttons / 2;
2106
2107 wv = xmalloc_widget_value ();
2108 wv->name = dialog_name;
2109 wv->help = Qnil;
2110
2111 /* Frame title: 'Q' = Question, 'I' = Information.
2112 Can also have 'E' = Error if, one day, we want
2113 a popup for errors. */
2114 if (NILP(header))
2115 dialog_name[0] = 'Q';
2116 else
2117 dialog_name[0] = 'I';
2118
2119 /* Dialog boxes use a really stupid name encoding
2120 which specifies how many buttons to use
2121 and how many buttons are on the right. */
2122 dialog_name[1] = '0' + nb_buttons;
2123 dialog_name[2] = 'B';
2124 dialog_name[3] = 'R';
2125 /* Number of buttons to put on the right. */
2126 dialog_name[4] = '0' + nb_buttons - left_count;
2127 dialog_name[5] = 0;
2128 wv->contents = first_wv;
2129 first_wv = wv;
2130 }
2131
2132 /* Actually create the dialog. */
2133 dialog_id = widget_id_tick++;
2134 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2135 f->output_data.w32->widget, 1, 0,
2136 dialog_selection_callback, 0);
2137 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2138
2139 /* Free the widget_value objects we used to specify the contents. */
2140 free_menubar_widget_value_tree (first_wv);
2141
2142 /* No selection has been chosen yet. */
2143 menu_item_selection = 0;
2144
2145 /* Display the menu. */
2146 lw_pop_up_all_widgets (dialog_id);
2147
2148 /* Process events that apply to the menu. */
2149 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2150
2151 lw_destroy_all_widgets (dialog_id);
2152
2153 /* Find the selected item, and its pane, to return
2154 the proper value. */
2155 if (menu_item_selection != 0)
2156 {
2157 Lisp_Object prefix;
2158
2159 prefix = Qnil;
2160 i = 0;
2161 while (i < menu_items_used)
2162 {
2163 Lisp_Object entry;
2164
2165 if (EQ (AREF (menu_items, i), Qt))
2166 {
2167 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2168 i += MENU_ITEMS_PANE_LENGTH;
2169 }
2170 else
2171 {
2172 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2173 if (menu_item_selection == i)
2174 {
2175 if (keymaps != 0)
2176 {
2177 entry = Fcons (entry, Qnil);
2178 if (!NILP (prefix))
2179 entry = Fcons (prefix, entry);
2180 }
2181 return entry;
2182 }
2183 i += MENU_ITEMS_ITEM_LENGTH;
2184 }
2185 }
2186 }
2187 else
2188 /* Make "Cancel" equivalent to C-g. */
2189 Fsignal (Qquit, Qnil);
2190
2191 return Qnil;
2192 }
2193 #endif /* HAVE_DIALOGS */
2194 \f
2195
2196 /* Is this item a separator? */
2197 static int
2198 name_is_separator (name)
2199 char *name;
2200 {
2201 char *start = name;
2202
2203 /* Check if name string consists of only dashes ('-'). */
2204 while (*name == '-') name++;
2205 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2206 or "--deep-shadow". We don't implement them yet, se we just treat
2207 them like normal separators. */
2208 return (*name == '\0' || start + 2 == name);
2209 }
2210
2211
2212 /* Indicate boundary between left and right. */
2213 static int
2214 add_left_right_boundary (HMENU menu)
2215 {
2216 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2217 }
2218
2219 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2220 static void
2221 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2222 {
2223 while (len > 0)
2224 {
2225 int utf16;
2226 if (*src < 0x80)
2227 {
2228 *dest = (WCHAR) *src;
2229 dest++; src++; len--;
2230 }
2231 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2232 else if (*src < 0xC0)
2233 {
2234 src++; len--;
2235 }
2236 /* 2 char UTF-8 sequence. */
2237 else if (*src < 0xE0)
2238 {
2239 *dest = (WCHAR) (((*src & 0x1f) << 6)
2240 | (*(src + 1) & 0x3f));
2241 src += 2; len -= 2; dest++;
2242 }
2243 else if (*src < 0xF0)
2244 {
2245 *dest = (WCHAR) (((*src & 0x0f) << 12)
2246 | ((*(src + 1) & 0x3f) << 6)
2247 | (*(src + 2) & 0x3f));
2248 src += 3; len -= 3; dest++;
2249 }
2250 else /* Not encodable. Insert Unicode Substitution char. */
2251 {
2252 *dest = (WCHAR) 0xfffd;
2253 src++; len--; dest++;
2254 }
2255 }
2256 *dest = 0;
2257 }
2258
2259 static int
2260 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2261 {
2262 UINT fuFlags;
2263 char *out_string;
2264 int return_value;
2265
2266 if (name_is_separator (wv->name))
2267 {
2268 fuFlags = MF_SEPARATOR;
2269 out_string = NULL;
2270 }
2271 else
2272 {
2273 if (wv->enabled)
2274 fuFlags = MF_STRING;
2275 else
2276 fuFlags = MF_STRING | MF_GRAYED;
2277
2278 if (wv->key != NULL)
2279 {
2280 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2281 strcpy (out_string, wv->name);
2282 strcat (out_string, "\t");
2283 strcat (out_string, wv->key);
2284 }
2285 else
2286 out_string = wv->name;
2287
2288 if (item != NULL)
2289 fuFlags = MF_POPUP;
2290 else if (wv->title || wv->call_data == 0)
2291 {
2292 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2293 we can't deallocate the memory otherwise. */
2294 if (get_menu_item_info)
2295 {
2296 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2297 strcpy (out_string, wv->name);
2298 #ifdef MENU_DEBUG
2299 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2300 #endif
2301 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2302 }
2303 else
2304 fuFlags = MF_DISABLED;
2305 }
2306
2307 /* Draw radio buttons and tickboxes. */
2308 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2309 wv->button_type == BUTTON_TYPE_RADIO))
2310 fuFlags |= MF_CHECKED;
2311 else
2312 fuFlags |= MF_UNCHECKED;
2313 }
2314
2315 if (unicode_append_menu && out_string)
2316 {
2317 /* Convert out_string from UTF-8 to UTF-16-LE. */
2318 int utf8_len = strlen (out_string);
2319 WCHAR * utf16_string;
2320 if (fuFlags & MF_OWNERDRAW)
2321 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2322 else
2323 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2324
2325 utf8to16 (out_string, utf8_len, utf16_string);
2326 return_value = unicode_append_menu (menu, fuFlags,
2327 item != NULL ? (UINT) item
2328 : (UINT) wv->call_data,
2329 utf16_string);
2330 if (!return_value)
2331 {
2332 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2333 apparently does exist at least in some cases and appears to be
2334 stubbed out to do nothing. out_string is UTF-8, but since
2335 our standard menus are in English and this is only going to
2336 happen the first time a menu is used, the encoding is
2337 of minor importance compared with menus not working at all. */
2338 return_value =
2339 AppendMenu (menu, fuFlags,
2340 item != NULL ? (UINT) item: (UINT) wv->call_data,
2341 out_string);
2342 /* Don't use unicode menus in future. */
2343 unicode_append_menu = NULL;
2344 }
2345
2346 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2347 local_free (out_string);
2348 }
2349 else
2350 {
2351 return_value =
2352 AppendMenu (menu,
2353 fuFlags,
2354 item != NULL ? (UINT) item : (UINT) wv->call_data,
2355 out_string );
2356 }
2357
2358 /* This must be done after the menu item is created. */
2359 if (!wv->title && wv->call_data != 0)
2360 {
2361 if (set_menu_item_info)
2362 {
2363 MENUITEMINFO info;
2364 bzero (&info, sizeof (info));
2365 info.cbSize = sizeof (info);
2366 info.fMask = MIIM_DATA;
2367
2368 /* Set help string for menu item. Leave it as a Lisp_Object
2369 until it is ready to be displayed, since GC can happen while
2370 menus are active. */
2371 if (!NILP (wv->help))
2372 #ifdef USE_LISP_UNION_TYPE
2373 info.dwItemData = (DWORD) (wv->help).i;
2374 #else
2375 info.dwItemData = (DWORD) (wv->help);
2376 #endif
2377 if (wv->button_type == BUTTON_TYPE_RADIO)
2378 {
2379 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2380 RADIO items, but is not available on NT 3.51 and earlier. */
2381 info.fMask |= MIIM_TYPE | MIIM_STATE;
2382 info.fType = MFT_RADIOCHECK | MFT_STRING;
2383 info.dwTypeData = out_string;
2384 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2385 }
2386
2387 set_menu_item_info (menu,
2388 item != NULL ? (UINT) item : (UINT) wv->call_data,
2389 FALSE, &info);
2390 }
2391 }
2392 return return_value;
2393 }
2394
2395 /* Construct native Windows menu(bar) based on widget_value tree. */
2396 int
2397 fill_in_menu (HMENU menu, widget_value *wv)
2398 {
2399 int items_added = 0;
2400
2401 for ( ; wv != NULL; wv = wv->next)
2402 {
2403 if (wv->contents)
2404 {
2405 HMENU sub_menu = CreatePopupMenu ();
2406
2407 if (sub_menu == NULL)
2408 return 0;
2409
2410 if (!fill_in_menu (sub_menu, wv->contents) ||
2411 !add_menu_item (menu, wv, sub_menu))
2412 {
2413 DestroyMenu (sub_menu);
2414 return 0;
2415 }
2416 }
2417 else
2418 {
2419 if (!add_menu_item (menu, wv, NULL))
2420 return 0;
2421 }
2422 }
2423 return 1;
2424 }
2425
2426 /* Display help string for currently pointed to menu item. Not
2427 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2428 available. */
2429 void
2430 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2431 {
2432 if (get_menu_item_info)
2433 {
2434 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2435 Lisp_Object frame, help;
2436
2437 /* No help echo on owner-draw menu items, or when the keyboard is used
2438 to navigate the menus, since tooltips are distracting if they pop
2439 up elsewhere. */
2440 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2441 || !(flags & MF_MOUSESELECT))
2442 help = Qnil;
2443 else
2444 {
2445 MENUITEMINFO info;
2446
2447 bzero (&info, sizeof (info));
2448 info.cbSize = sizeof (info);
2449 info.fMask = MIIM_DATA;
2450 get_menu_item_info (menu, item, FALSE, &info);
2451
2452 #ifdef USE_LISP_UNION_TYPE
2453 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2454 : Qnil;
2455 #else
2456 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2457 #endif
2458 }
2459
2460 /* Store the help echo in the keyboard buffer as the X toolkit
2461 version does, rather than directly showing it. This seems to
2462 solve the GC problems that were present when we based the
2463 Windows code on the non-toolkit version. */
2464 if (f)
2465 {
2466 XSETFRAME (frame, f);
2467 kbd_buffer_store_help_event (frame, help);
2468 }
2469 else
2470 /* X version has a loop through frames here, which doesn't
2471 appear to do anything, unless it has some side effect. */
2472 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2473 }
2474 }
2475
2476 /* Free memory used by owner-drawn strings. */
2477 static void
2478 w32_free_submenu_strings (menu)
2479 HMENU menu;
2480 {
2481 int i, num = GetMenuItemCount (menu);
2482 for (i = 0; i < num; i++)
2483 {
2484 MENUITEMINFO info;
2485 bzero (&info, sizeof (info));
2486 info.cbSize = sizeof (info);
2487 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2488
2489 get_menu_item_info (menu, i, TRUE, &info);
2490
2491 /* Owner-drawn names are held in dwItemData. */
2492 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2493 {
2494 #ifdef MENU_DEBUG
2495 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2496 #endif
2497 local_free (info.dwItemData);
2498 }
2499
2500 /* Recurse down submenus. */
2501 if (info.hSubMenu)
2502 w32_free_submenu_strings (info.hSubMenu);
2503 }
2504 }
2505
2506 void
2507 w32_free_menu_strings (hwnd)
2508 HWND hwnd;
2509 {
2510 HMENU menu = current_popup_menu;
2511
2512 if (get_menu_item_info)
2513 {
2514 /* If there is no popup menu active, free the strings from the frame's
2515 menubar. */
2516 if (!menu)
2517 menu = GetMenu (hwnd);
2518
2519 if (menu)
2520 w32_free_submenu_strings (menu);
2521 }
2522
2523 current_popup_menu = NULL;
2524 }
2525
2526 #endif /* HAVE_MENUS */
2527
2528 /* The following is used by delayed window autoselection. */
2529
2530 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2531 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2532 ()
2533 {
2534 #ifdef HAVE_MENUS
2535 FRAME_PTR f;
2536 f = SELECTED_FRAME ();
2537 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2538 #else
2539 return Qnil;
2540 #endif /* HAVE_MENUS */
2541 }
2542
2543 void syms_of_w32menu ()
2544 {
2545 globals_of_w32menu ();
2546 staticpro (&menu_items);
2547 menu_items = Qnil;
2548
2549 current_popup_menu = NULL;
2550
2551 Qdebug_on_next_call = intern ("debug-on-next-call");
2552 staticpro (&Qdebug_on_next_call);
2553
2554 defsubr (&Sx_popup_menu);
2555 defsubr (&Smenu_or_popup_active_p);
2556 #ifdef HAVE_MENUS
2557 defsubr (&Sx_popup_dialog);
2558 #endif
2559 }
2560
2561 /*
2562 globals_of_w32menu is used to initialize those global variables that
2563 must always be initialized on startup even when the global variable
2564 initialized is non zero (see the function main in emacs.c).
2565 globals_of_w32menu is called from syms_of_w32menu when the global
2566 variable initialized is 0 and directly from main when initialized
2567 is non zero.
2568 */
2569 void globals_of_w32menu ()
2570 {
2571 /* See if Get/SetMenuItemInfo functions are available. */
2572 HMODULE user32 = GetModuleHandle ("user32.dll");
2573 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2574 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2575 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2576 }
2577
2578 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2579 (do not change this comment) */