(x_set_alpha): Set alpha to -1 if nil given.
[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, 2008
4 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22
23 #include <signal.h>
24 #include <stdio.h>
25 #include <mbstring.h>
26
27 #include "lisp.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31 #include "termhooks.h"
32 #include "window.h"
33 #include "blockinput.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "character.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 #ifndef TRUE
54 #define TRUE 1
55 #define FALSE 0
56 #endif /* no TRUE */
57
58 HMENU current_popup_menu;
59
60 void syms_of_w32menu ();
61 void globals_of_w32menu ();
62
63 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
64 IN HMENU,
65 IN UINT,
66 IN BOOL,
67 IN OUT LPMENUITEMINFOA);
68 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
69 IN HMENU,
70 IN UINT,
71 IN BOOL,
72 IN LPCMENUITEMINFOA);
73
74 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
75 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
76 AppendMenuW_Proc unicode_append_menu = NULL;
77
78 Lisp_Object Qdebug_on_next_call;
79
80 extern Lisp_Object Vmenu_updating_frame;
81
82 extern Lisp_Object Qmenu_bar;
83
84 extern Lisp_Object QCtoggle, QCradio;
85
86 extern Lisp_Object Voverriding_local_map;
87 extern Lisp_Object Voverriding_local_map_menu_flag;
88
89 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
90
91 extern Lisp_Object Qmenu_bar_update_hook;
92
93 void set_frame_menubar P_ ((FRAME_PTR, int, int));
94
95 #ifdef HAVE_DIALOGS
96 static Lisp_Object w32_dialog_show P_ ((FRAME_PTR, int, Lisp_Object, char**));
97 #else
98 static int is_simple_dialog P_ ((Lisp_Object));
99 static Lisp_Object simple_dialog_show P_ ((FRAME_PTR, Lisp_Object, Lisp_Object));
100 #endif
101 static Lisp_Object w32_menu_show P_ ((FRAME_PTR, int, int, int, int,
102 Lisp_Object, char **));
103
104 void w32_free_menu_strings P_((HWND));
105 \f
106
107 /* This is set nonzero after the user activates the menu bar, and set
108 to zero again after the menu bars are redisplayed by prepare_menu_bar.
109 While it is nonzero, all calls to set_frame_menubar go deep.
110
111 I don't understand why this is needed, but it does seem to be
112 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
113
114 int pending_menu_activation;
115 \f
116
117 /* Return the frame whose ->output_data.w32->menubar_widget equals
118 ID, or 0 if none. */
119
120 static struct frame *
121 menubar_id_to_frame (id)
122 HMENU id;
123 {
124 Lisp_Object tail, frame;
125 FRAME_PTR f;
126
127 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
128 {
129 frame = XCAR (tail);
130 if (!FRAMEP (frame))
131 continue;
132 f = XFRAME (frame);
133 if (!FRAME_WINDOW_P (f))
134 continue;
135 if (f->output_data.w32->menubar_widget == id)
136 return f;
137 }
138 return 0;
139 }
140 \f
141 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
142 doc: /* Pop up a deck-of-cards menu and return user's selection.
143 POSITION is a position specification. This is either a mouse button
144 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
145 are positions in pixels from the top left corner of WINDOW's frame
146 \(WINDOW may be a frame object instead of a window). This controls the
147 position of the center of the first line in the first pane of the
148 menu, not the top left of the menu as a whole. If POSITION is t, it
149 means to use the current mouse position.
150
151 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
152 The menu items come from key bindings that have a menu string as well as
153 a definition; actually, the \"definition\" in such a key binding looks like
154 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
155 the keymap as a top-level element.
156
157 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
158 Otherwise, REAL-DEFINITION should be a valid key binding definition.
159
160 You can also use a list of keymaps as MENU. Then each keymap makes a
161 separate pane. When MENU is a keymap or a list of keymaps, the return
162 value is a list of events.
163
164 Alternatively, you can specify a menu of multiple panes with a list of
165 the form (TITLE PANE1 PANE2...), where each pane is a list of
166 form (TITLE ITEM1 ITEM2...).
167 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
168 appear as an item--that makes a nonselectable line in the menu.
169 With this form of menu, the return value is VALUE from the chosen item.
170
171 If POSITION is nil, don't display the menu at all, just precalculate the
172 cached information about equivalent key sequences. */)
173 (position, menu)
174 Lisp_Object position, menu;
175 {
176 Lisp_Object keymap, tem;
177 int xpos = 0, ypos = 0;
178 Lisp_Object title;
179 char *error_name;
180 Lisp_Object selection;
181 FRAME_PTR f = NULL;
182 Lisp_Object x, y, window;
183 int keymaps = 0;
184 int for_click = 0;
185 int specpdl_count = SPECPDL_INDEX ();
186 struct gcpro gcpro1;
187
188 #ifdef HAVE_MENUS
189 if (! NILP (position))
190 {
191 check_w32 ();
192
193 /* Decode the first argument: find the window and the coordinates. */
194 if (EQ (position, Qt)
195 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
196 || EQ (XCAR (position), Qtool_bar))))
197 {
198 /* Use the mouse's current position. */
199 FRAME_PTR new_f = SELECTED_FRAME ();
200 Lisp_Object bar_window;
201 enum scroll_bar_part part;
202 unsigned long time;
203
204 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
205 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
206 &part, &x, &y, &time);
207 if (new_f != 0)
208 XSETFRAME (window, new_f);
209 else
210 {
211 window = selected_window;
212 XSETFASTINT (x, 0);
213 XSETFASTINT (y, 0);
214 }
215 }
216 else
217 {
218 tem = Fcar (position);
219 if (CONSP (tem))
220 {
221 window = Fcar (Fcdr (position));
222 x = Fcar (tem);
223 y = Fcar (Fcdr (tem));
224 }
225 else
226 {
227 for_click = 1;
228 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
229 window = Fcar (tem); /* POSN_WINDOW (tem) */
230 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
231 x = Fcar (tem);
232 y = Fcdr (tem);
233 }
234 }
235
236 CHECK_NUMBER (x);
237 CHECK_NUMBER (y);
238
239 /* Decode where to put the menu. */
240
241 if (FRAMEP (window))
242 {
243 f = XFRAME (window);
244 xpos = 0;
245 ypos = 0;
246 }
247 else if (WINDOWP (window))
248 {
249 CHECK_LIVE_WINDOW (window);
250 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
251
252 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
253 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
254 }
255 else
256 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
257 but I don't want to make one now. */
258 CHECK_WINDOW (window);
259
260 xpos += XINT (x);
261 ypos += XINT (y);
262
263 XSETFRAME (Vmenu_updating_frame, f);
264 }
265 else
266 Vmenu_updating_frame = Qnil;
267 #endif /* HAVE_MENUS */
268
269 record_unwind_protect (unuse_menu_items, Qnil);
270
271 title = Qnil;
272 GCPRO1 (title);
273
274 /* Decode the menu items from what was specified. */
275
276 keymap = get_keymap (menu, 0, 0);
277 if (CONSP (keymap))
278 {
279 /* We were given a keymap. Extract menu info from the keymap. */
280 Lisp_Object prompt;
281
282 /* Extract the detailed info to make one pane. */
283 keymap_panes (&menu, 1, NILP (position));
284
285 /* Search for a string appearing directly as an element of the keymap.
286 That string is the title of the menu. */
287 prompt = Fkeymap_prompt (keymap);
288 if (NILP (title) && !NILP (prompt))
289 title = prompt;
290
291 /* Make that be the pane title of the first pane. */
292 if (!NILP (prompt) && menu_items_n_panes >= 0)
293 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
294
295 keymaps = 1;
296 }
297 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
298 {
299 /* We were given a list of keymaps. */
300 int nmaps = XFASTINT (Flength (menu));
301 Lisp_Object *maps
302 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
303 int i;
304
305 title = Qnil;
306
307 /* The first keymap that has a prompt string
308 supplies the menu title. */
309 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
310 {
311 Lisp_Object prompt;
312
313 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
314
315 prompt = Fkeymap_prompt (keymap);
316 if (NILP (title) && !NILP (prompt))
317 title = prompt;
318 }
319
320 /* Extract the detailed info to make one pane. */
321 keymap_panes (maps, nmaps, NILP (position));
322
323 /* Make the title be the pane title of the first pane. */
324 if (!NILP (title) && menu_items_n_panes >= 0)
325 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
326
327 keymaps = 1;
328 }
329 else
330 {
331 /* We were given an old-fashioned menu. */
332 title = Fcar (menu);
333 CHECK_STRING (title);
334
335 list_of_panes (Fcdr (menu));
336
337 keymaps = 0;
338 }
339
340 unbind_to (specpdl_count, Qnil);
341
342 if (NILP (position))
343 {
344 discard_menu_items ();
345 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
346 UNGCPRO;
347 return Qnil;
348 }
349
350 #ifdef HAVE_MENUS
351 /* If resources from a previous popup menu still exist, does nothing
352 until the `menu_free_timer' has freed them (see w32fns.c). This
353 can occur if you press ESC or click outside a menu without selecting
354 a menu item.
355 */
356 if (current_popup_menu)
357 {
358 discard_menu_items ();
359 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
360 UNGCPRO;
361 return Qnil;
362 }
363
364 /* Display them in a menu. */
365 BLOCK_INPUT;
366
367 selection = w32_menu_show (f, xpos, ypos, for_click,
368 keymaps, title, &error_name);
369 UNBLOCK_INPUT;
370
371 discard_menu_items ();
372 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
373
374 #endif /* HAVE_MENUS */
375
376 UNGCPRO;
377
378 if (error_name) error (error_name);
379 return selection;
380 }
381
382 #ifdef HAVE_MENUS
383
384 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
385 doc: /* Pop up a dialog box and return user's selection.
386 POSITION specifies which frame to use.
387 This is normally a mouse button event or a window or frame.
388 If POSITION is t, it means to use the frame the mouse is on.
389 The dialog box appears in the middle of the specified frame.
390
391 CONTENTS specifies the alternatives to display in the dialog box.
392 It is a list of the form (TITLE ITEM1 ITEM2...).
393 Each ITEM is a cons cell (STRING . VALUE).
394 The return value is VALUE from the chosen item.
395
396 An ITEM may also be just a string--that makes a nonselectable item.
397 An ITEM may also be nil--that means to put all preceding items
398 on the left of the dialog box and all following items on the right.
399 \(By default, approximately half appear on each side.)
400
401 If HEADER is non-nil, the frame title for the box is "Information",
402 otherwise it is "Question". */)
403 (position, contents, header)
404 Lisp_Object position, contents, header;
405 {
406 FRAME_PTR f = NULL;
407 Lisp_Object window;
408
409 check_w32 ();
410
411 /* Decode the first argument: find the window or frame to use. */
412 if (EQ (position, Qt)
413 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
414 || EQ (XCAR (position), Qtool_bar))))
415 {
416 #if 0 /* Using the frame the mouse is on may not be right. */
417 /* Use the mouse's current position. */
418 FRAME_PTR new_f = SELECTED_FRAME ();
419 Lisp_Object bar_window;
420 enum scroll_bar_part part;
421 unsigned long time;
422 Lisp_Object x, y;
423
424 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
425
426 if (new_f != 0)
427 XSETFRAME (window, new_f);
428 else
429 window = selected_window;
430 #endif
431 window = selected_window;
432 }
433 else if (CONSP (position))
434 {
435 Lisp_Object tem;
436 tem = Fcar (position);
437 if (CONSP (tem))
438 window = Fcar (Fcdr (position));
439 else
440 {
441 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
442 window = Fcar (tem); /* POSN_WINDOW (tem) */
443 }
444 }
445 else if (WINDOWP (position) || FRAMEP (position))
446 window = position;
447 else
448 window = Qnil;
449
450 /* Decode where to put the menu. */
451
452 if (FRAMEP (window))
453 f = XFRAME (window);
454 else if (WINDOWP (window))
455 {
456 CHECK_LIVE_WINDOW (window);
457 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
458 }
459 else
460 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
461 but I don't want to make one now. */
462 CHECK_WINDOW (window);
463
464 #ifndef HAVE_DIALOGS
465
466 {
467 /* Handle simple Yes/No choices as MessageBox popups. */
468 if (is_simple_dialog (contents))
469 return simple_dialog_show (f, contents, header);
470 else
471 {
472 /* Display a menu with these alternatives
473 in the middle of frame F. */
474 Lisp_Object x, y, frame, newpos;
475 XSETFRAME (frame, f);
476 XSETINT (x, x_pixel_width (f) / 2);
477 XSETINT (y, x_pixel_height (f) / 2);
478 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
479 return Fx_popup_menu (newpos,
480 Fcons (Fcar (contents), Fcons (contents, Qnil)));
481 }
482 }
483 #else /* HAVE_DIALOGS */
484 {
485 Lisp_Object title;
486 char *error_name;
487 Lisp_Object selection;
488
489 /* Decode the dialog items from what was specified. */
490 title = Fcar (contents);
491 CHECK_STRING (title);
492
493 list_of_panes (Fcons (contents, Qnil));
494
495 /* Display them in a dialog box. */
496 BLOCK_INPUT;
497 selection = w32_dialog_show (f, 0, title, header, &error_name);
498 UNBLOCK_INPUT;
499
500 discard_menu_items ();
501 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
502
503 if (error_name) error (error_name);
504 return selection;
505 }
506 #endif /* HAVE_DIALOGS */
507 }
508
509 /* Activate the menu bar of frame F.
510 This is called from keyboard.c when it gets the
511 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
512
513 To activate the menu bar, we signal to the input thread that it can
514 return from the WM_INITMENU message, allowing the normal Windows
515 processing of the menus.
516
517 But first we recompute the menu bar contents (the whole tree).
518
519 This way we can safely execute Lisp code. */
520
521 void
522 x_activate_menubar (f)
523 FRAME_PTR f;
524 {
525 set_frame_menubar (f, 0, 1);
526
527 /* Lock out further menubar changes while active. */
528 f->output_data.w32->menubar_active = 1;
529
530 /* Signal input thread to return from WM_INITMENU. */
531 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
532 }
533
534 /* This callback is called from the menu bar pulldown menu
535 when the user makes a selection.
536 Figure out what the user chose
537 and put the appropriate events into the keyboard buffer. */
538
539 void
540 menubar_selection_callback (FRAME_PTR f, void * client_data)
541 {
542 Lisp_Object prefix, entry;
543 Lisp_Object vector;
544 Lisp_Object *subprefix_stack;
545 int submenu_depth = 0;
546 int i;
547
548 if (!f)
549 return;
550 entry = Qnil;
551 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
552 vector = f->menu_bar_vector;
553 prefix = Qnil;
554 i = 0;
555 while (i < f->menu_bar_items_used)
556 {
557 if (EQ (AREF (vector, i), Qnil))
558 {
559 subprefix_stack[submenu_depth++] = prefix;
560 prefix = entry;
561 i++;
562 }
563 else if (EQ (AREF (vector, i), Qlambda))
564 {
565 prefix = subprefix_stack[--submenu_depth];
566 i++;
567 }
568 else if (EQ (AREF (vector, i), Qt))
569 {
570 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
571 i += MENU_ITEMS_PANE_LENGTH;
572 }
573 else
574 {
575 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
576 /* The EMACS_INT cast avoids a warning. There's no problem
577 as long as pointers have enough bits to hold small integers. */
578 if ((int) (EMACS_INT) client_data == i)
579 {
580 int j;
581 struct input_event buf;
582 Lisp_Object frame;
583 EVENT_INIT (buf);
584
585 XSETFRAME (frame, f);
586 buf.kind = MENU_BAR_EVENT;
587 buf.frame_or_window = frame;
588 buf.arg = frame;
589 kbd_buffer_store_event (&buf);
590
591 for (j = 0; j < submenu_depth; j++)
592 if (!NILP (subprefix_stack[j]))
593 {
594 buf.kind = MENU_BAR_EVENT;
595 buf.frame_or_window = frame;
596 buf.arg = subprefix_stack[j];
597 kbd_buffer_store_event (&buf);
598 }
599
600 if (!NILP (prefix))
601 {
602 buf.kind = MENU_BAR_EVENT;
603 buf.frame_or_window = frame;
604 buf.arg = prefix;
605 kbd_buffer_store_event (&buf);
606 }
607
608 buf.kind = MENU_BAR_EVENT;
609 buf.frame_or_window = frame;
610 buf.arg = entry;
611 /* Free memory used by owner-drawn and help-echo strings. */
612 w32_free_menu_strings (FRAME_W32_WINDOW (f));
613 kbd_buffer_store_event (&buf);
614
615 f->output_data.w32->menubar_active = 0;
616 return;
617 }
618 i += MENU_ITEMS_ITEM_LENGTH;
619 }
620 }
621 /* Free memory used by owner-drawn and help-echo strings. */
622 w32_free_menu_strings (FRAME_W32_WINDOW (f));
623 f->output_data.w32->menubar_active = 0;
624 }
625
626 \f
627 /* Set the contents of the menubar widgets of frame F.
628 The argument FIRST_TIME is currently ignored;
629 it is set the first time this is called, from initialize_frame_menubar. */
630
631 void
632 set_frame_menubar (f, first_time, deep_p)
633 FRAME_PTR f;
634 int first_time;
635 int deep_p;
636 {
637 HMENU menubar_widget = f->output_data.w32->menubar_widget;
638 Lisp_Object items;
639 widget_value *wv, *first_wv, *prev_wv = 0;
640 int i, last_i;
641 int *submenu_start, *submenu_end;
642 int *submenu_top_level_items, *submenu_n_panes;
643
644 /* We must not change the menubar when actually in use. */
645 if (f->output_data.w32->menubar_active)
646 return;
647
648 XSETFRAME (Vmenu_updating_frame, f);
649
650 if (! menubar_widget)
651 deep_p = 1;
652 else if (pending_menu_activation && !deep_p)
653 deep_p = 1;
654
655 if (deep_p)
656 {
657 /* Make a widget-value tree representing the entire menu trees. */
658
659 struct buffer *prev = current_buffer;
660 Lisp_Object buffer;
661 int specpdl_count = SPECPDL_INDEX ();
662 int previous_menu_items_used = f->menu_bar_items_used;
663 Lisp_Object *previous_items
664 = (Lisp_Object *) alloca (previous_menu_items_used
665 * sizeof (Lisp_Object));
666
667 /* If we are making a new widget, its contents are empty,
668 do always reinitialize them. */
669 if (! menubar_widget)
670 previous_menu_items_used = 0;
671
672 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
673 specbind (Qinhibit_quit, Qt);
674 /* Don't let the debugger step into this code
675 because it is not reentrant. */
676 specbind (Qdebug_on_next_call, Qnil);
677
678 record_unwind_save_match_data ();
679
680 if (NILP (Voverriding_local_map_menu_flag))
681 {
682 specbind (Qoverriding_terminal_local_map, Qnil);
683 specbind (Qoverriding_local_map, Qnil);
684 }
685
686 set_buffer_internal_1 (XBUFFER (buffer));
687
688 /* Run the Lucid hook. */
689 safe_run_hooks (Qactivate_menubar_hook);
690 /* If it has changed current-menubar from previous value,
691 really recompute the menubar from the value. */
692 if (! NILP (Vlucid_menu_bar_dirty_flag))
693 call0 (Qrecompute_lucid_menubar);
694 safe_run_hooks (Qmenu_bar_update_hook);
695 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
696
697 items = FRAME_MENU_BAR_ITEMS (f);
698
699 /* Save the frame's previous menu bar contents data. */
700 if (previous_menu_items_used)
701 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
702 previous_menu_items_used * sizeof (Lisp_Object));
703
704 /* Fill in menu_items with the current menu bar contents.
705 This can evaluate Lisp code. */
706 save_menu_items ();
707
708 menu_items = f->menu_bar_vector;
709 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
710 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
711 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
712 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
713 submenu_top_level_items
714 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
715 init_menu_items ();
716 for (i = 0; i < ASIZE (items); i += 4)
717 {
718 Lisp_Object key, string, maps;
719
720 last_i = i;
721
722 key = AREF (items, i);
723 string = AREF (items, i + 1);
724 maps = AREF (items, i + 2);
725 if (NILP (string))
726 break;
727
728 submenu_start[i] = menu_items_used;
729
730 menu_items_n_panes = 0;
731 submenu_top_level_items[i]
732 = parse_single_submenu (key, string, maps);
733 submenu_n_panes[i] = menu_items_n_panes;
734
735 submenu_end[i] = menu_items_used;
736 }
737
738 finish_menu_items ();
739
740 /* Convert menu_items into widget_value trees
741 to display the menu. This cannot evaluate Lisp code. */
742
743 wv = xmalloc_widget_value ();
744 wv->name = "menubar";
745 wv->value = 0;
746 wv->enabled = 1;
747 wv->button_type = BUTTON_TYPE_NONE;
748 wv->help = Qnil;
749 first_wv = wv;
750
751 for (i = 0; i < last_i; i += 4)
752 {
753 menu_items_n_panes = submenu_n_panes[i];
754 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
755 submenu_top_level_items[i]);
756 if (prev_wv)
757 prev_wv->next = wv;
758 else
759 first_wv->contents = wv;
760 /* Don't set wv->name here; GC during the loop might relocate it. */
761 wv->enabled = 1;
762 wv->button_type = BUTTON_TYPE_NONE;
763 prev_wv = wv;
764 }
765
766 set_buffer_internal_1 (prev);
767
768 /* If there has been no change in the Lisp-level contents
769 of the menu bar, skip redisplaying it. Just exit. */
770
771 for (i = 0; i < previous_menu_items_used; i++)
772 if (menu_items_used == i
773 || (!EQ (previous_items[i], AREF (menu_items, i))))
774 break;
775 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
776 {
777 free_menubar_widget_value_tree (first_wv);
778 discard_menu_items ();
779 unbind_to (specpdl_count, Qnil);
780 return;
781 }
782
783 f->menu_bar_vector = menu_items;
784 f->menu_bar_items_used = menu_items_used;
785
786 /* This undoes save_menu_items. */
787 unbind_to (specpdl_count, Qnil);
788
789 /* Now GC cannot happen during the lifetime of the widget_value,
790 so it's safe to store data from a Lisp_String, as long as
791 local copies are made when the actual menu is created.
792 Windows takes care of this for normal string items, but
793 not for owner-drawn items or additional item-info. */
794 wv = first_wv->contents;
795 for (i = 0; i < ASIZE (items); i += 4)
796 {
797 Lisp_Object string;
798 string = AREF (items, i + 1);
799 if (NILP (string))
800 break;
801 wv->name = (char *) SDATA (string);
802 update_submenu_strings (wv->contents);
803 wv = wv->next;
804 }
805 }
806 else
807 {
808 /* Make a widget-value tree containing
809 just the top level menu bar strings. */
810
811 wv = xmalloc_widget_value ();
812 wv->name = "menubar";
813 wv->value = 0;
814 wv->enabled = 1;
815 wv->button_type = BUTTON_TYPE_NONE;
816 wv->help = Qnil;
817 first_wv = wv;
818
819 items = FRAME_MENU_BAR_ITEMS (f);
820 for (i = 0; i < ASIZE (items); i += 4)
821 {
822 Lisp_Object string;
823
824 string = AREF (items, i + 1);
825 if (NILP (string))
826 break;
827
828 wv = xmalloc_widget_value ();
829 wv->name = (char *) SDATA (string);
830 wv->value = 0;
831 wv->enabled = 1;
832 wv->button_type = BUTTON_TYPE_NONE;
833 wv->help = Qnil;
834 /* This prevents lwlib from assuming this
835 menu item is really supposed to be empty. */
836 /* The EMACS_INT cast avoids a warning.
837 This value just has to be different from small integers. */
838 wv->call_data = (void *) (EMACS_INT) (-1);
839
840 if (prev_wv)
841 prev_wv->next = wv;
842 else
843 first_wv->contents = wv;
844 prev_wv = wv;
845 }
846
847 /* Forget what we thought we knew about what is in the
848 detailed contents of the menu bar menus.
849 Changing the top level always destroys the contents. */
850 f->menu_bar_items_used = 0;
851 }
852
853 /* Create or update the menu bar widget. */
854
855 BLOCK_INPUT;
856
857 if (menubar_widget)
858 {
859 /* Empty current menubar, rather than creating a fresh one. */
860 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
861 ;
862 }
863 else
864 {
865 menubar_widget = CreateMenu ();
866 }
867 fill_in_menu (menubar_widget, first_wv->contents);
868
869 free_menubar_widget_value_tree (first_wv);
870
871 {
872 HMENU old_widget = f->output_data.w32->menubar_widget;
873
874 f->output_data.w32->menubar_widget = menubar_widget;
875 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
876 /* Causes flicker when menu bar is updated
877 DrawMenuBar (FRAME_W32_WINDOW (f)); */
878
879 /* Force the window size to be recomputed so that the frame's text
880 area remains the same, if menubar has just been created. */
881 if (old_widget == NULL)
882 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
883 }
884
885 UNBLOCK_INPUT;
886 }
887
888 /* Called from Fx_create_frame to create the initial menubar of a frame
889 before it is mapped, so that the window is mapped with the menubar already
890 there instead of us tacking it on later and thrashing the window after it
891 is visible. */
892
893 void
894 initialize_frame_menubar (f)
895 FRAME_PTR f;
896 {
897 /* This function is called before the first chance to redisplay
898 the frame. It has to be, so the frame will have the right size. */
899 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
900 set_frame_menubar (f, 1, 1);
901 }
902
903 /* Get rid of the menu bar of frame F, and free its storage.
904 This is used when deleting a frame, and when turning off the menu bar. */
905
906 void
907 free_frame_menubar (f)
908 FRAME_PTR f;
909 {
910 BLOCK_INPUT;
911
912 {
913 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
914 SetMenu (FRAME_W32_WINDOW (f), NULL);
915 f->output_data.w32->menubar_widget = NULL;
916 DestroyMenu (old);
917 }
918
919 UNBLOCK_INPUT;
920 }
921
922 \f
923 /* w32_menu_show actually displays a menu using the panes and items in
924 menu_items and returns the value selected from it; we assume input
925 is blocked by the caller. */
926
927 /* F is the frame the menu is for.
928 X and Y are the frame-relative specified position,
929 relative to the inside upper left corner of the frame F.
930 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
931 KEYMAPS is 1 if this menu was specified with keymaps;
932 in that case, we return a list containing the chosen item's value
933 and perhaps also the pane's prefix.
934 TITLE is the specified menu title.
935 ERROR is a place to store an error message string in case of failure.
936 (We return nil on failure, but the value doesn't actually matter.) */
937
938 static Lisp_Object
939 w32_menu_show (f, x, y, for_click, keymaps, title, error)
940 FRAME_PTR f;
941 int x;
942 int y;
943 int for_click;
944 int keymaps;
945 Lisp_Object title;
946 char **error;
947 {
948 int i;
949 int menu_item_selection;
950 HMENU menu;
951 POINT pos;
952 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
953 widget_value **submenu_stack
954 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
955 Lisp_Object *subprefix_stack
956 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
957 int submenu_depth = 0;
958 int first_pane;
959
960 *error = NULL;
961
962 if (menu_items_n_panes == 0)
963 return Qnil;
964
965 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
966 {
967 *error = "Empty menu";
968 return Qnil;
969 }
970
971 /* Create a tree of widget_value objects
972 representing the panes and their items. */
973 wv = xmalloc_widget_value ();
974 wv->name = "menu";
975 wv->value = 0;
976 wv->enabled = 1;
977 wv->button_type = BUTTON_TYPE_NONE;
978 wv->help = Qnil;
979 first_wv = wv;
980 first_pane = 1;
981
982 /* Loop over all panes and items, filling in the tree. */
983 i = 0;
984 while (i < menu_items_used)
985 {
986 if (EQ (AREF (menu_items, i), Qnil))
987 {
988 submenu_stack[submenu_depth++] = save_wv;
989 save_wv = prev_wv;
990 prev_wv = 0;
991 first_pane = 1;
992 i++;
993 }
994 else if (EQ (AREF (menu_items, i), Qlambda))
995 {
996 prev_wv = save_wv;
997 save_wv = submenu_stack[--submenu_depth];
998 first_pane = 0;
999 i++;
1000 }
1001 else if (EQ (AREF (menu_items, i), Qt)
1002 && submenu_depth != 0)
1003 i += MENU_ITEMS_PANE_LENGTH;
1004 /* Ignore a nil in the item list.
1005 It's meaningful only for dialog boxes. */
1006 else if (EQ (AREF (menu_items, i), Qquote))
1007 i += 1;
1008 else if (EQ (AREF (menu_items, i), Qt))
1009 {
1010 /* Create a new pane. */
1011 Lisp_Object pane_name, prefix;
1012 char *pane_string;
1013 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1014 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1015
1016 if (STRINGP (pane_name))
1017 {
1018 if (unicode_append_menu)
1019 pane_name = ENCODE_UTF_8 (pane_name);
1020 else if (STRING_MULTIBYTE (pane_name))
1021 pane_name = ENCODE_SYSTEM (pane_name);
1022
1023 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1024 }
1025
1026 pane_string = (NILP (pane_name)
1027 ? "" : (char *) SDATA (pane_name));
1028 /* If there is just one top-level pane, put all its items directly
1029 under the top-level menu. */
1030 if (menu_items_n_panes == 1)
1031 pane_string = "";
1032
1033 /* If the pane has a meaningful name,
1034 make the pane a top-level menu item
1035 with its items as a submenu beneath it. */
1036 if (!keymaps && strcmp (pane_string, ""))
1037 {
1038 wv = xmalloc_widget_value ();
1039 if (save_wv)
1040 save_wv->next = wv;
1041 else
1042 first_wv->contents = wv;
1043 wv->name = pane_string;
1044 if (keymaps && !NILP (prefix))
1045 wv->name++;
1046 wv->value = 0;
1047 wv->enabled = 1;
1048 wv->button_type = BUTTON_TYPE_NONE;
1049 wv->help = Qnil;
1050 save_wv = wv;
1051 prev_wv = 0;
1052 }
1053 else if (first_pane)
1054 {
1055 save_wv = wv;
1056 prev_wv = 0;
1057 }
1058 first_pane = 0;
1059 i += MENU_ITEMS_PANE_LENGTH;
1060 }
1061 else
1062 {
1063 /* Create a new item within current pane. */
1064 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1065
1066 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1067 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1068 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1069 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1070 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1071 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1072 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1073
1074 if (STRINGP (item_name))
1075 {
1076 if (unicode_append_menu)
1077 item_name = ENCODE_UTF_8 (item_name);
1078 else if (STRING_MULTIBYTE (item_name))
1079 item_name = ENCODE_SYSTEM (item_name);
1080
1081 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1082 }
1083
1084 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1085 {
1086 descrip = ENCODE_SYSTEM (descrip);
1087 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1088 }
1089
1090 wv = xmalloc_widget_value ();
1091 if (prev_wv)
1092 prev_wv->next = wv;
1093 else
1094 save_wv->contents = wv;
1095 wv->name = (char *) SDATA (item_name);
1096 if (!NILP (descrip))
1097 wv->key = (char *) SDATA (descrip);
1098 wv->value = 0;
1099 /* Use the contents index as call_data, since we are
1100 restricted to 16-bits. */
1101 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1102 wv->enabled = !NILP (enable);
1103
1104 if (NILP (type))
1105 wv->button_type = BUTTON_TYPE_NONE;
1106 else if (EQ (type, QCtoggle))
1107 wv->button_type = BUTTON_TYPE_TOGGLE;
1108 else if (EQ (type, QCradio))
1109 wv->button_type = BUTTON_TYPE_RADIO;
1110 else
1111 abort ();
1112
1113 wv->selected = !NILP (selected);
1114
1115 if (!STRINGP (help))
1116 help = Qnil;
1117
1118 wv->help = help;
1119
1120 prev_wv = wv;
1121
1122 i += MENU_ITEMS_ITEM_LENGTH;
1123 }
1124 }
1125
1126 /* Deal with the title, if it is non-nil. */
1127 if (!NILP (title))
1128 {
1129 widget_value *wv_title = xmalloc_widget_value ();
1130 widget_value *wv_sep = xmalloc_widget_value ();
1131
1132 /* Maybe replace this separator with a bitmap or owner-draw item
1133 so that it looks better. Having two separators looks odd. */
1134 wv_sep->name = "--";
1135 wv_sep->next = first_wv->contents;
1136 wv_sep->help = Qnil;
1137
1138 if (unicode_append_menu)
1139 title = ENCODE_UTF_8 (title);
1140 else if (STRING_MULTIBYTE (title))
1141 title = ENCODE_SYSTEM (title);
1142
1143 wv_title->name = (char *) SDATA (title);
1144 wv_title->enabled = TRUE;
1145 wv_title->title = TRUE;
1146 wv_title->button_type = BUTTON_TYPE_NONE;
1147 wv_title->help = Qnil;
1148 wv_title->next = wv_sep;
1149 first_wv->contents = wv_title;
1150 }
1151
1152 /* No selection has been chosen yet. */
1153 menu_item_selection = 0;
1154
1155 /* Actually create the menu. */
1156 current_popup_menu = menu = CreatePopupMenu ();
1157 fill_in_menu (menu, first_wv->contents);
1158
1159 /* Adjust coordinates to be root-window-relative. */
1160 pos.x = x;
1161 pos.y = y;
1162 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1163
1164 /* Display the menu. */
1165 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1166 WM_EMACS_TRACKPOPUPMENU,
1167 (WPARAM)menu, (LPARAM)&pos);
1168
1169 /* Clean up extraneous mouse events which might have been generated
1170 during the call. */
1171 discard_mouse_events ();
1172 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1173
1174 /* Free the widget_value objects we used to specify the contents. */
1175 free_menubar_widget_value_tree (first_wv);
1176
1177 DestroyMenu (menu);
1178
1179 /* Free the owner-drawn and help-echo menu strings. */
1180 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1181 f->output_data.w32->menubar_active = 0;
1182
1183 /* Find the selected item, and its pane, to return
1184 the proper value. */
1185 if (menu_item_selection != 0)
1186 {
1187 Lisp_Object prefix, entry;
1188
1189 prefix = entry = Qnil;
1190 i = 0;
1191 while (i < menu_items_used)
1192 {
1193 if (EQ (AREF (menu_items, i), Qnil))
1194 {
1195 subprefix_stack[submenu_depth++] = prefix;
1196 prefix = entry;
1197 i++;
1198 }
1199 else if (EQ (AREF (menu_items, i), Qlambda))
1200 {
1201 prefix = subprefix_stack[--submenu_depth];
1202 i++;
1203 }
1204 else if (EQ (AREF (menu_items, i), Qt))
1205 {
1206 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1207 i += MENU_ITEMS_PANE_LENGTH;
1208 }
1209 /* Ignore a nil in the item list.
1210 It's meaningful only for dialog boxes. */
1211 else if (EQ (AREF (menu_items, i), Qquote))
1212 i += 1;
1213 else
1214 {
1215 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1216 if (menu_item_selection == i)
1217 {
1218 if (keymaps != 0)
1219 {
1220 int j;
1221
1222 entry = Fcons (entry, Qnil);
1223 if (!NILP (prefix))
1224 entry = Fcons (prefix, entry);
1225 for (j = submenu_depth - 1; j >= 0; j--)
1226 if (!NILP (subprefix_stack[j]))
1227 entry = Fcons (subprefix_stack[j], entry);
1228 }
1229 return entry;
1230 }
1231 i += MENU_ITEMS_ITEM_LENGTH;
1232 }
1233 }
1234 }
1235 else if (!for_click)
1236 /* Make "Cancel" equivalent to C-g. */
1237 Fsignal (Qquit, Qnil);
1238
1239 return Qnil;
1240 }
1241 \f
1242
1243 #ifdef HAVE_DIALOGS
1244 /* TODO: On Windows, there are two ways of defining a dialog.
1245
1246 1. Create a predefined dialog resource and include it in nt/emacs.rc.
1247 Using this method, we could then set the titles and make unneeded
1248 buttons invisible before displaying the dialog. Everything would
1249 be a fixed size though, so there is a risk that text does not
1250 fit on a button.
1251 2. Create the dialog template in memory on the fly. This allows us
1252 to size the dialog and buttons dynamically, probably giving more
1253 natural looking results for dialogs with few buttons, and eliminating
1254 the problem of text overflowing the buttons. But the API for this is
1255 quite complex - structures have to be allocated in particular ways,
1256 text content is tacked onto the end of structures in variable length
1257 arrays with further structures tacked on after these, there are
1258 certain alignment requirements for all this, and we have to
1259 measure all the text and convert to "dialog coordinates" to figure
1260 out how big to make everything.
1261
1262 For now, we'll just stick with menus for dialogs that are more
1263 complicated than simple yes/no type questions for which we can use
1264 the MessageBox function.
1265 */
1266
1267 static char * button_names [] = {
1268 "button1", "button2", "button3", "button4", "button5",
1269 "button6", "button7", "button8", "button9", "button10" };
1270
1271 static Lisp_Object
1272 w32_dialog_show (f, keymaps, title, header, error)
1273 FRAME_PTR f;
1274 int keymaps;
1275 Lisp_Object title, header;
1276 char **error;
1277 {
1278 int i, nb_buttons=0;
1279 char dialog_name[6];
1280 int menu_item_selection;
1281
1282 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1283
1284 /* Number of elements seen so far, before boundary. */
1285 int left_count = 0;
1286 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1287 int boundary_seen = 0;
1288
1289 *error = NULL;
1290
1291 if (menu_items_n_panes > 1)
1292 {
1293 *error = "Multiple panes in dialog box";
1294 return Qnil;
1295 }
1296
1297 /* Create a tree of widget_value objects
1298 representing the text label and buttons. */
1299 {
1300 Lisp_Object pane_name, prefix;
1301 char *pane_string;
1302 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
1303 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
1304 pane_string = (NILP (pane_name)
1305 ? "" : (char *) SDATA (pane_name));
1306 prev_wv = xmalloc_widget_value ();
1307 prev_wv->value = pane_string;
1308 if (keymaps && !NILP (prefix))
1309 prev_wv->name++;
1310 prev_wv->enabled = 1;
1311 prev_wv->name = "message";
1312 prev_wv->help = Qnil;
1313 first_wv = prev_wv;
1314
1315 /* Loop over all panes and items, filling in the tree. */
1316 i = MENU_ITEMS_PANE_LENGTH;
1317 while (i < menu_items_used)
1318 {
1319
1320 /* Create a new item within current pane. */
1321 Lisp_Object item_name, enable, descrip, help;
1322
1323 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1324 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1325 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1326 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1327
1328 if (NILP (item_name))
1329 {
1330 free_menubar_widget_value_tree (first_wv);
1331 *error = "Submenu in dialog items";
1332 return Qnil;
1333 }
1334 if (EQ (item_name, Qquote))
1335 {
1336 /* This is the boundary between left-side elts
1337 and right-side elts. Stop incrementing right_count. */
1338 boundary_seen = 1;
1339 i++;
1340 continue;
1341 }
1342 if (nb_buttons >= 9)
1343 {
1344 free_menubar_widget_value_tree (first_wv);
1345 *error = "Too many dialog items";
1346 return Qnil;
1347 }
1348
1349 wv = xmalloc_widget_value ();
1350 prev_wv->next = wv;
1351 wv->name = (char *) button_names[nb_buttons];
1352 if (!NILP (descrip))
1353 wv->key = (char *) SDATA (descrip);
1354 wv->value = (char *) SDATA (item_name);
1355 wv->call_data = (void *) &AREF (menu_items, i);
1356 wv->enabled = !NILP (enable);
1357 wv->help = Qnil;
1358 prev_wv = wv;
1359
1360 if (! boundary_seen)
1361 left_count++;
1362
1363 nb_buttons++;
1364 i += MENU_ITEMS_ITEM_LENGTH;
1365 }
1366
1367 /* If the boundary was not specified,
1368 by default put half on the left and half on the right. */
1369 if (! boundary_seen)
1370 left_count = nb_buttons - nb_buttons / 2;
1371
1372 wv = xmalloc_widget_value ();
1373 wv->name = dialog_name;
1374 wv->help = Qnil;
1375
1376 /* Frame title: 'Q' = Question, 'I' = Information.
1377 Can also have 'E' = Error if, one day, we want
1378 a popup for errors. */
1379 if (NILP(header))
1380 dialog_name[0] = 'Q';
1381 else
1382 dialog_name[0] = 'I';
1383
1384 /* Dialog boxes use a really stupid name encoding
1385 which specifies how many buttons to use
1386 and how many buttons are on the right. */
1387 dialog_name[1] = '0' + nb_buttons;
1388 dialog_name[2] = 'B';
1389 dialog_name[3] = 'R';
1390 /* Number of buttons to put on the right. */
1391 dialog_name[4] = '0' + nb_buttons - left_count;
1392 dialog_name[5] = 0;
1393 wv->contents = first_wv;
1394 first_wv = wv;
1395 }
1396
1397 /* Actually create the dialog. */
1398 dialog_id = widget_id_tick++;
1399 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1400 f->output_data.w32->widget, 1, 0,
1401 dialog_selection_callback, 0);
1402 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
1403
1404 /* Free the widget_value objects we used to specify the contents. */
1405 free_menubar_widget_value_tree (first_wv);
1406
1407 /* No selection has been chosen yet. */
1408 menu_item_selection = 0;
1409
1410 /* Display the menu. */
1411 lw_pop_up_all_widgets (dialog_id);
1412
1413 /* Process events that apply to the menu. */
1414 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1415
1416 lw_destroy_all_widgets (dialog_id);
1417
1418 /* Find the selected item, and its pane, to return
1419 the proper value. */
1420 if (menu_item_selection != 0)
1421 {
1422 Lisp_Object prefix;
1423
1424 prefix = Qnil;
1425 i = 0;
1426 while (i < menu_items_used)
1427 {
1428 Lisp_Object entry;
1429
1430 if (EQ (AREF (menu_items, i), Qt))
1431 {
1432 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1433 i += MENU_ITEMS_PANE_LENGTH;
1434 }
1435 else
1436 {
1437 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1438 if (menu_item_selection == i)
1439 {
1440 if (keymaps != 0)
1441 {
1442 entry = Fcons (entry, Qnil);
1443 if (!NILP (prefix))
1444 entry = Fcons (prefix, entry);
1445 }
1446 return entry;
1447 }
1448 i += MENU_ITEMS_ITEM_LENGTH;
1449 }
1450 }
1451 }
1452 else
1453 /* Make "Cancel" equivalent to C-g. */
1454 Fsignal (Qquit, Qnil);
1455
1456 return Qnil;
1457 }
1458 #else /* !HAVE_DIALOGS */
1459
1460 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
1461 simple dialogs. We could handle a few more, but I'm not aware of
1462 anywhere in Emacs that uses the other specific dialog choices that
1463 MessageBox provides. */
1464
1465 static int is_simple_dialog (contents)
1466 Lisp_Object contents;
1467 {
1468 Lisp_Object options = XCDR (contents);
1469 Lisp_Object name, yes, no, other;
1470
1471 yes = build_string ("Yes");
1472 no = build_string ("No");
1473
1474 if (!CONSP (options))
1475 return 0;
1476
1477 name = XCAR (XCAR (options));
1478 if (!CONSP (options))
1479 return 0;
1480
1481 if (!NILP (Fstring_equal (name, yes)))
1482 other = no;
1483 else if (!NILP (Fstring_equal (name, no)))
1484 other = yes;
1485 else
1486 return 0;
1487
1488 options = XCDR (options);
1489 if (!CONSP (options))
1490 return 0;
1491
1492 name = XCAR (XCAR (options));
1493 if (NILP (Fstring_equal (name, other)))
1494 return 0;
1495
1496 /* Check there are no more options. */
1497 options = XCDR (options);
1498 return !(CONSP (options));
1499 }
1500
1501 static Lisp_Object simple_dialog_show (f, contents, header)
1502 FRAME_PTR f;
1503 Lisp_Object contents, header;
1504 {
1505 int answer;
1506 UINT type;
1507 char *text, *title;
1508 Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
1509
1510 if (STRINGP (temp))
1511 text = SDATA (temp);
1512 else
1513 text = "";
1514
1515 if (NILP (header))
1516 {
1517 title = "Question";
1518 type = MB_ICONQUESTION;
1519 }
1520 else
1521 {
1522 title = "Information";
1523 type = MB_ICONINFORMATION;
1524 }
1525 type |= MB_YESNO;
1526
1527 /* Since we only handle Yes/No dialogs, and we already checked
1528 is_simple_dialog, we don't need to worry about checking contents
1529 to see what type of dialog to use. */
1530 answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
1531
1532 if (answer == IDYES)
1533 lispy_answer = build_string ("Yes");
1534 else if (answer == IDNO)
1535 lispy_answer = build_string ("No");
1536 else
1537 Fsignal (Qquit, Qnil);
1538
1539 for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
1540 {
1541 Lisp_Object item, name, value;
1542 item = XCAR (temp);
1543 if (CONSP (item))
1544 {
1545 name = XCAR (item);
1546 value = XCDR (item);
1547 }
1548 else
1549 {
1550 name = item;
1551 value = Qnil;
1552 }
1553
1554 if (!NILP (Fstring_equal (name, lispy_answer)))
1555 {
1556 return value;
1557 }
1558 }
1559 Fsignal (Qquit, Qnil);
1560 return Qnil;
1561 }
1562 #endif /* !HAVE_DIALOGS */
1563 \f
1564
1565 /* Is this item a separator? */
1566 static int
1567 name_is_separator (name)
1568 char *name;
1569 {
1570 char *start = name;
1571
1572 /* Check if name string consists of only dashes ('-'). */
1573 while (*name == '-') name++;
1574 /* Separators can also be of the form "--:TripleSuperMegaEtched"
1575 or "--deep-shadow". We don't implement them yet, se we just treat
1576 them like normal separators. */
1577 return (*name == '\0' || start + 2 == name);
1578 }
1579
1580
1581 /* Indicate boundary between left and right. */
1582 static int
1583 add_left_right_boundary (HMENU menu)
1584 {
1585 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
1586 }
1587
1588 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
1589 static void
1590 utf8to16 (unsigned char * src, int len, WCHAR * dest)
1591 {
1592 while (len > 0)
1593 {
1594 int utf16;
1595 if (*src < 0x80)
1596 {
1597 *dest = (WCHAR) *src;
1598 dest++; src++; len--;
1599 }
1600 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
1601 else if (*src < 0xC0)
1602 {
1603 src++; len--;
1604 }
1605 /* 2 char UTF-8 sequence. */
1606 else if (*src < 0xE0)
1607 {
1608 *dest = (WCHAR) (((*src & 0x1f) << 6)
1609 | (*(src + 1) & 0x3f));
1610 src += 2; len -= 2; dest++;
1611 }
1612 else if (*src < 0xF0)
1613 {
1614 *dest = (WCHAR) (((*src & 0x0f) << 12)
1615 | ((*(src + 1) & 0x3f) << 6)
1616 | (*(src + 2) & 0x3f));
1617 src += 3; len -= 3; dest++;
1618 }
1619 else /* Not encodable. Insert Unicode Substitution char. */
1620 {
1621 *dest = (WCHAR) 0xfffd;
1622 src++; len--; dest++;
1623 }
1624 }
1625 *dest = 0;
1626 }
1627
1628 static int
1629 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
1630 {
1631 UINT fuFlags;
1632 char *out_string, *p, *q;
1633 int return_value;
1634 size_t nlen, orig_len;
1635
1636 if (name_is_separator (wv->name))
1637 {
1638 fuFlags = MF_SEPARATOR;
1639 out_string = NULL;
1640 }
1641 else
1642 {
1643 if (wv->enabled)
1644 fuFlags = MF_STRING;
1645 else
1646 fuFlags = MF_STRING | MF_GRAYED;
1647
1648 if (wv->key != NULL)
1649 {
1650 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
1651 strcpy (out_string, wv->name);
1652 strcat (out_string, "\t");
1653 strcat (out_string, wv->key);
1654 }
1655 else
1656 out_string = wv->name;
1657
1658 /* Quote any special characters within the menu item's text and
1659 key binding. */
1660 nlen = orig_len = strlen (out_string);
1661 if (unicode_append_menu)
1662 {
1663 /* With UTF-8, & cannot be part of a multibyte character. */
1664 for (p = out_string; *p; p++)
1665 {
1666 if (*p == '&')
1667 nlen++;
1668 }
1669 }
1670 else
1671 {
1672 /* If encoded with the system codepage, use multibyte string
1673 functions in case of multibyte characters that contain '&'. */
1674 for (p = out_string; *p; p = _mbsinc (p))
1675 {
1676 if (_mbsnextc (p) == '&')
1677 nlen++;
1678 }
1679 }
1680
1681 if (nlen > orig_len)
1682 {
1683 p = out_string;
1684 out_string = alloca (nlen + 1);
1685 q = out_string;
1686 while (*p)
1687 {
1688 if (unicode_append_menu)
1689 {
1690 if (*p == '&')
1691 *q++ = *p;
1692 *q++ = *p++;
1693 }
1694 else
1695 {
1696 if (_mbsnextc (p) == '&')
1697 {
1698 _mbsncpy (q, p, 1);
1699 q = _mbsinc (q);
1700 }
1701 _mbsncpy (q, p, 1);
1702 p = _mbsinc (p);
1703 q = _mbsinc (q);
1704 }
1705 }
1706 *q = '\0';
1707 }
1708
1709 if (item != NULL)
1710 fuFlags = MF_POPUP;
1711 else if (wv->title || wv->call_data == 0)
1712 {
1713 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
1714 we can't deallocate the memory otherwise. */
1715 if (get_menu_item_info)
1716 {
1717 out_string = (char *) local_alloc (strlen (wv->name) + 1);
1718 strcpy (out_string, wv->name);
1719 #ifdef MENU_DEBUG
1720 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
1721 #endif
1722 fuFlags = MF_OWNERDRAW | MF_DISABLED;
1723 }
1724 else
1725 fuFlags = MF_DISABLED;
1726 }
1727
1728 /* Draw radio buttons and tickboxes. */
1729 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
1730 wv->button_type == BUTTON_TYPE_RADIO))
1731 fuFlags |= MF_CHECKED;
1732 else
1733 fuFlags |= MF_UNCHECKED;
1734 }
1735
1736 if (unicode_append_menu && out_string)
1737 {
1738 /* Convert out_string from UTF-8 to UTF-16-LE. */
1739 int utf8_len = strlen (out_string);
1740 WCHAR * utf16_string;
1741 if (fuFlags & MF_OWNERDRAW)
1742 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
1743 else
1744 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
1745
1746 utf8to16 (out_string, utf8_len, utf16_string);
1747 return_value = unicode_append_menu (menu, fuFlags,
1748 item != NULL ? (UINT) item
1749 : (UINT) wv->call_data,
1750 utf16_string);
1751 if (!return_value)
1752 {
1753 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
1754 apparently does exist at least in some cases and appears to be
1755 stubbed out to do nothing. out_string is UTF-8, but since
1756 our standard menus are in English and this is only going to
1757 happen the first time a menu is used, the encoding is
1758 of minor importance compared with menus not working at all. */
1759 return_value =
1760 AppendMenu (menu, fuFlags,
1761 item != NULL ? (UINT) item: (UINT) wv->call_data,
1762 out_string);
1763 /* Don't use unicode menus in future. */
1764 unicode_append_menu = NULL;
1765 }
1766
1767 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
1768 local_free (out_string);
1769 }
1770 else
1771 {
1772 return_value =
1773 AppendMenu (menu,
1774 fuFlags,
1775 item != NULL ? (UINT) item : (UINT) wv->call_data,
1776 out_string );
1777 }
1778
1779 /* This must be done after the menu item is created. */
1780 if (!wv->title && wv->call_data != 0)
1781 {
1782 if (set_menu_item_info)
1783 {
1784 MENUITEMINFO info;
1785 bzero (&info, sizeof (info));
1786 info.cbSize = sizeof (info);
1787 info.fMask = MIIM_DATA;
1788
1789 /* Set help string for menu item. Leave it as a Lisp_Object
1790 until it is ready to be displayed, since GC can happen while
1791 menus are active. */
1792 if (!NILP (wv->help))
1793 #ifdef USE_LISP_UNION_TYPE
1794 info.dwItemData = (DWORD) (wv->help).i;
1795 #else
1796 info.dwItemData = (DWORD) (wv->help);
1797 #endif
1798 if (wv->button_type == BUTTON_TYPE_RADIO)
1799 {
1800 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
1801 RADIO items, but is not available on NT 3.51 and earlier. */
1802 info.fMask |= MIIM_TYPE | MIIM_STATE;
1803 info.fType = MFT_RADIOCHECK | MFT_STRING;
1804 info.dwTypeData = out_string;
1805 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
1806 }
1807
1808 set_menu_item_info (menu,
1809 item != NULL ? (UINT) item : (UINT) wv->call_data,
1810 FALSE, &info);
1811 }
1812 }
1813 return return_value;
1814 }
1815
1816 /* Construct native Windows menu(bar) based on widget_value tree. */
1817 int
1818 fill_in_menu (HMENU menu, widget_value *wv)
1819 {
1820 int items_added = 0;
1821
1822 for ( ; wv != NULL; wv = wv->next)
1823 {
1824 if (wv->contents)
1825 {
1826 HMENU sub_menu = CreatePopupMenu ();
1827
1828 if (sub_menu == NULL)
1829 return 0;
1830
1831 if (!fill_in_menu (sub_menu, wv->contents) ||
1832 !add_menu_item (menu, wv, sub_menu))
1833 {
1834 DestroyMenu (sub_menu);
1835 return 0;
1836 }
1837 }
1838 else
1839 {
1840 if (!add_menu_item (menu, wv, NULL))
1841 return 0;
1842 }
1843 }
1844 return 1;
1845 }
1846
1847 /* Display help string for currently pointed to menu item. Not
1848 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
1849 available. */
1850 void
1851 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
1852 {
1853 if (get_menu_item_info)
1854 {
1855 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
1856 Lisp_Object frame, help;
1857
1858 /* No help echo on owner-draw menu items, or when the keyboard is used
1859 to navigate the menus, since tooltips are distracting if they pop
1860 up elsewhere. */
1861 if (flags & MF_OWNERDRAW || flags & MF_POPUP
1862 || !(flags & MF_MOUSESELECT))
1863 help = Qnil;
1864 else
1865 {
1866 MENUITEMINFO info;
1867
1868 bzero (&info, sizeof (info));
1869 info.cbSize = sizeof (info);
1870 info.fMask = MIIM_DATA;
1871 get_menu_item_info (menu, item, FALSE, &info);
1872
1873 #ifdef USE_LISP_UNION_TYPE
1874 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
1875 : Qnil;
1876 #else
1877 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
1878 #endif
1879 }
1880
1881 /* Store the help echo in the keyboard buffer as the X toolkit
1882 version does, rather than directly showing it. This seems to
1883 solve the GC problems that were present when we based the
1884 Windows code on the non-toolkit version. */
1885 if (f)
1886 {
1887 XSETFRAME (frame, f);
1888 kbd_buffer_store_help_event (frame, help);
1889 }
1890 else
1891 /* X version has a loop through frames here, which doesn't
1892 appear to do anything, unless it has some side effect. */
1893 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1894 }
1895 }
1896
1897 /* Free memory used by owner-drawn strings. */
1898 static void
1899 w32_free_submenu_strings (menu)
1900 HMENU menu;
1901 {
1902 int i, num = GetMenuItemCount (menu);
1903 for (i = 0; i < num; i++)
1904 {
1905 MENUITEMINFO info;
1906 bzero (&info, sizeof (info));
1907 info.cbSize = sizeof (info);
1908 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
1909
1910 get_menu_item_info (menu, i, TRUE, &info);
1911
1912 /* Owner-drawn names are held in dwItemData. */
1913 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
1914 {
1915 #ifdef MENU_DEBUG
1916 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
1917 #endif
1918 local_free (info.dwItemData);
1919 }
1920
1921 /* Recurse down submenus. */
1922 if (info.hSubMenu)
1923 w32_free_submenu_strings (info.hSubMenu);
1924 }
1925 }
1926
1927 void
1928 w32_free_menu_strings (hwnd)
1929 HWND hwnd;
1930 {
1931 HMENU menu = current_popup_menu;
1932
1933 if (get_menu_item_info)
1934 {
1935 /* If there is no popup menu active, free the strings from the frame's
1936 menubar. */
1937 if (!menu)
1938 menu = GetMenu (hwnd);
1939
1940 if (menu)
1941 w32_free_submenu_strings (menu);
1942 }
1943
1944 current_popup_menu = NULL;
1945 }
1946
1947 #endif /* HAVE_MENUS */
1948
1949 /* The following is used by delayed window autoselection. */
1950
1951 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
1952 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
1953 ()
1954 {
1955 #ifdef HAVE_MENUS
1956 FRAME_PTR f;
1957 f = SELECTED_FRAME ();
1958 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
1959 #else
1960 return Qnil;
1961 #endif /* HAVE_MENUS */
1962 }
1963
1964 void syms_of_w32menu ()
1965 {
1966 globals_of_w32menu ();
1967
1968 current_popup_menu = NULL;
1969
1970 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
1971
1972 defsubr (&Sx_popup_menu);
1973 defsubr (&Smenu_or_popup_active_p);
1974 #ifdef HAVE_MENUS
1975 defsubr (&Sx_popup_dialog);
1976 #endif
1977 }
1978
1979 /*
1980 globals_of_w32menu is used to initialize those global variables that
1981 must always be initialized on startup even when the global variable
1982 initialized is non zero (see the function main in emacs.c).
1983 globals_of_w32menu is called from syms_of_w32menu when the global
1984 variable initialized is 0 and directly from main when initialized
1985 is non zero.
1986 */
1987 void globals_of_w32menu ()
1988 {
1989 /* See if Get/SetMenuItemInfo functions are available. */
1990 HMODULE user32 = GetModuleHandle ("user32.dll");
1991 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
1992 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
1993 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
1994 }
1995
1996 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
1997 (do not change this comment) */