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