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