(bug-reference-map): Bind down-mouse-1 rather than mouse-1.
[emacs.git] / src / w32menu.c
blob4de203c9b3940a7859613b9a4b4b7effc9626dcc
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.
6 This file is part of GNU Emacs.
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.
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.
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/>. */
21 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <mbstring.h>
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"
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"
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
49 #include "dispextern.h"
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
53 #ifndef TRUE
54 #define TRUE 1
55 #define FALSE 0
56 #endif /* no TRUE */
58 HMENU current_popup_menu;
60 void syms_of_w32menu ();
61 void globals_of_w32menu ();
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);
74 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
75 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
76 AppendMenuW_Proc unicode_append_menu = NULL;
78 Lisp_Object Qdebug_on_next_call;
80 extern Lisp_Object Vmenu_updating_frame;
82 extern Lisp_Object Qmenu_bar;
84 extern Lisp_Object QCtoggle, QCradio;
86 extern Lisp_Object Voverriding_local_map;
87 extern Lisp_Object Voverriding_local_map_menu_flag;
89 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
91 extern Lisp_Object Qmenu_bar_update_hook;
93 void set_frame_menubar P_ ((FRAME_PTR, int, int));
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 **));
104 void w32_free_menu_strings P_((HWND));
106 static int next_menubar_widget_id;
108 extern widget_value *xmalloc_widget_value P_ ((void));
109 extern widget_value *digest_single_submenu P_ ((int, int, int));
111 /* This is set nonzero after the user activates the menu bar, and set
112 to zero again after the menu bars are redisplayed by prepare_menu_bar.
113 While it is nonzero, all calls to set_frame_menubar go deep.
115 I don't understand why this is needed, but it does seem to be
116 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
118 int pending_menu_activation;
121 /* Return the frame whose ->output_data.w32->menubar_widget equals
122 ID, or 0 if none. */
124 static struct frame *
125 menubar_id_to_frame (id)
126 HMENU id;
128 Lisp_Object tail, frame;
129 FRAME_PTR f;
131 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
133 frame = XCAR (tail);
134 if (!FRAMEP (frame))
135 continue;
136 f = XFRAME (frame);
137 if (!FRAME_WINDOW_P (f))
138 continue;
139 if (f->output_data.w32->menubar_widget == id)
140 return f;
142 return 0;
145 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
146 doc: /* Pop up a deck-of-cards menu and return user's selection.
147 POSITION is a position specification. This is either a mouse button
148 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
149 are positions in pixels from the top left corner of WINDOW's frame
150 \(WINDOW may be a frame object instead of a window). This controls the
151 position of the center of the first line in the first pane of the
152 menu, not the top left of the menu as a whole. If POSITION is t, it
153 means to use the current mouse position.
155 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
156 The menu items come from key bindings that have a menu string as well as
157 a definition; actually, the \"definition\" in such a key binding looks like
158 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
159 the keymap as a top-level element.
161 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
162 Otherwise, REAL-DEFINITION should be a valid key binding definition.
164 You can also use a list of keymaps as MENU. Then each keymap makes a
165 separate pane. When MENU is a keymap or a list of keymaps, the return
166 value is a list of events.
168 Alternatively, you can specify a menu of multiple panes with a list of
169 the form (TITLE PANE1 PANE2...), where each pane is a list of
170 form (TITLE ITEM1 ITEM2...).
171 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
172 appear as an item--that makes a nonselectable line in the menu.
173 With this form of menu, the return value is VALUE from the chosen item.
175 If POSITION is nil, don't display the menu at all, just precalculate the
176 cached information about equivalent key sequences. */)
177 (position, menu)
178 Lisp_Object position, menu;
180 Lisp_Object keymap, tem;
181 int xpos = 0, ypos = 0;
182 Lisp_Object title;
183 char *error_name;
184 Lisp_Object selection;
185 FRAME_PTR f = NULL;
186 Lisp_Object x, y, window;
187 int keymaps = 0;
188 int for_click = 0;
189 int specpdl_count = SPECPDL_INDEX ();
190 struct gcpro gcpro1;
192 #ifdef HAVE_MENUS
193 if (! NILP (position))
195 check_w32 ();
197 /* Decode the first argument: find the window and the coordinates. */
198 if (EQ (position, Qt)
199 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
200 || EQ (XCAR (position), Qtool_bar))))
202 /* Use the mouse's current position. */
203 FRAME_PTR new_f = SELECTED_FRAME ();
204 Lisp_Object bar_window;
205 enum scroll_bar_part part;
206 unsigned long time;
208 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
209 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
210 &part, &x, &y, &time);
211 if (new_f != 0)
212 XSETFRAME (window, new_f);
213 else
215 window = selected_window;
216 XSETFASTINT (x, 0);
217 XSETFASTINT (y, 0);
220 else
222 tem = Fcar (position);
223 if (CONSP (tem))
225 window = Fcar (Fcdr (position));
226 x = Fcar (tem);
227 y = Fcar (Fcdr (tem));
229 else
231 for_click = 1;
232 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
233 window = Fcar (tem); /* POSN_WINDOW (tem) */
234 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
235 x = Fcar (tem);
236 y = Fcdr (tem);
240 CHECK_NUMBER (x);
241 CHECK_NUMBER (y);
243 /* Decode where to put the menu. */
245 if (FRAMEP (window))
247 f = XFRAME (window);
248 xpos = 0;
249 ypos = 0;
251 else if (WINDOWP (window))
253 CHECK_LIVE_WINDOW (window);
254 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
256 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
257 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
259 else
260 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
261 but I don't want to make one now. */
262 CHECK_WINDOW (window);
264 xpos += XINT (x);
265 ypos += XINT (y);
267 XSETFRAME (Vmenu_updating_frame, f);
269 else
270 Vmenu_updating_frame = Qnil;
271 #endif /* HAVE_MENUS */
273 record_unwind_protect (unuse_menu_items, Qnil);
275 title = Qnil;
276 GCPRO1 (title);
278 /* Decode the menu items from what was specified. */
280 keymap = get_keymap (menu, 0, 0);
281 if (CONSP (keymap))
283 /* We were given a keymap. Extract menu info from the keymap. */
284 Lisp_Object prompt;
286 /* Extract the detailed info to make one pane. */
287 keymap_panes (&menu, 1, NILP (position));
289 /* Search for a string appearing directly as an element of the keymap.
290 That string is the title of the menu. */
291 prompt = Fkeymap_prompt (keymap);
292 if (NILP (title) && !NILP (prompt))
293 title = prompt;
295 /* Make that be the pane title of the first pane. */
296 if (!NILP (prompt) && menu_items_n_panes >= 0)
297 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
299 keymaps = 1;
301 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
303 /* We were given a list of keymaps. */
304 int nmaps = XFASTINT (Flength (menu));
305 Lisp_Object *maps
306 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
307 int i;
309 title = Qnil;
311 /* The first keymap that has a prompt string
312 supplies the menu title. */
313 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
315 Lisp_Object prompt;
317 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
319 prompt = Fkeymap_prompt (keymap);
320 if (NILP (title) && !NILP (prompt))
321 title = prompt;
324 /* Extract the detailed info to make one pane. */
325 keymap_panes (maps, nmaps, NILP (position));
327 /* Make the title be the pane title of the first pane. */
328 if (!NILP (title) && menu_items_n_panes >= 0)
329 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
331 keymaps = 1;
333 else
335 /* We were given an old-fashioned menu. */
336 title = Fcar (menu);
337 CHECK_STRING (title);
339 list_of_panes (Fcdr (menu));
341 keymaps = 0;
344 unbind_to (specpdl_count, Qnil);
346 if (NILP (position))
348 discard_menu_items ();
349 UNGCPRO;
350 return Qnil;
353 #ifdef HAVE_MENUS
354 /* If resources from a previous popup menu still exist, does nothing
355 until the `menu_free_timer' has freed them (see w32fns.c). This
356 can occur if you press ESC or click outside a menu without selecting
357 a menu item.
359 if (current_popup_menu)
361 discard_menu_items ();
362 UNGCPRO;
363 return Qnil;
366 /* Display them in a menu. */
367 BLOCK_INPUT;
369 selection = w32_menu_show (f, xpos, ypos, for_click,
370 keymaps, title, &error_name);
371 UNBLOCK_INPUT;
373 discard_menu_items ();
375 #endif /* HAVE_MENUS */
377 UNGCPRO;
379 if (error_name) error (error_name);
380 return selection;
383 #ifdef HAVE_MENUS
385 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
386 doc: /* Pop up a dialog box and return user's selection.
387 POSITION specifies which frame to use.
388 This is normally a mouse button event or a window or frame.
389 If POSITION is t, it means to use the frame the mouse is on.
390 The dialog box appears in the middle of the specified frame.
392 CONTENTS specifies the alternatives to display in the dialog box.
393 It is a list of the form (TITLE ITEM1 ITEM2...).
394 Each ITEM is a cons cell (STRING . VALUE).
395 The return value is VALUE from the chosen item.
397 An ITEM may also be just a string--that makes a nonselectable item.
398 An ITEM may also be nil--that means to put all preceding items
399 on the left of the dialog box and all following items on the right.
400 \(By default, approximately half appear on each side.)
402 If HEADER is non-nil, the frame title for the box is "Information",
403 otherwise it is "Question". */)
404 (position, contents, header)
405 Lisp_Object position, contents, header;
407 FRAME_PTR f = NULL;
408 Lisp_Object window;
410 check_w32 ();
412 /* Decode the first argument: find the window or frame to use. */
413 if (EQ (position, Qt)
414 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
415 || EQ (XCAR (position), Qtool_bar))))
417 #if 0 /* Using the frame the mouse is on may not be right. */
418 /* Use the mouse's current position. */
419 FRAME_PTR new_f = SELECTED_FRAME ();
420 Lisp_Object bar_window;
421 enum scroll_bar_part part;
422 unsigned long time;
423 Lisp_Object x, y;
425 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
427 if (new_f != 0)
428 XSETFRAME (window, new_f);
429 else
430 window = selected_window;
431 #endif
432 window = selected_window;
434 else if (CONSP (position))
436 Lisp_Object tem;
437 tem = Fcar (position);
438 if (CONSP (tem))
439 window = Fcar (Fcdr (position));
440 else
442 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
443 window = Fcar (tem); /* POSN_WINDOW (tem) */
446 else if (WINDOWP (position) || FRAMEP (position))
447 window = position;
448 else
449 window = Qnil;
451 /* Decode where to put the menu. */
453 if (FRAMEP (window))
454 f = XFRAME (window);
455 else if (WINDOWP (window))
457 CHECK_LIVE_WINDOW (window);
458 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
460 else
461 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
462 but I don't want to make one now. */
463 CHECK_WINDOW (window);
465 #ifndef HAVE_DIALOGS
468 /* Handle simple Yes/No choices as MessageBox popups. */
469 if (is_simple_dialog (contents))
470 return simple_dialog_show (f, contents, header);
471 else
473 /* Display a menu with these alternatives
474 in the middle of frame F. */
475 Lisp_Object x, y, frame, newpos;
476 XSETFRAME (frame, f);
477 XSETINT (x, x_pixel_width (f) / 2);
478 XSETINT (y, x_pixel_height (f) / 2);
479 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
480 return Fx_popup_menu (newpos,
481 Fcons (Fcar (contents), Fcons (contents, Qnil)));
484 #else /* HAVE_DIALOGS */
486 Lisp_Object title;
487 char *error_name;
488 Lisp_Object selection;
490 /* Decode the dialog items from what was specified. */
491 title = Fcar (contents);
492 CHECK_STRING (title);
494 list_of_panes (Fcons (contents, Qnil));
496 /* Display them in a dialog box. */
497 BLOCK_INPUT;
498 selection = w32_dialog_show (f, 0, title, header, &error_name);
499 UNBLOCK_INPUT;
501 discard_menu_items ();
503 if (error_name) error (error_name);
504 return selection;
506 #endif /* HAVE_DIALOGS */
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.
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.
517 But first we recompute the menu bar contents (the whole tree).
519 This way we can safely execute Lisp code. */
521 void
522 x_activate_menubar (f)
523 FRAME_PTR f;
525 set_frame_menubar (f, 0, 1);
527 /* Lock out further menubar changes while active. */
528 f->output_data.w32->menubar_active = 1;
530 /* Signal input thread to return from WM_INITMENU. */
531 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
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. */
539 void
540 menubar_selection_callback (FRAME_PTR f, void * client_data)
542 Lisp_Object prefix, entry;
543 Lisp_Object vector;
544 Lisp_Object *subprefix_stack;
545 int submenu_depth = 0;
546 int i;
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)
557 if (EQ (AREF (vector, i), Qnil))
559 subprefix_stack[submenu_depth++] = prefix;
560 prefix = entry;
561 i++;
563 else if (EQ (AREF (vector, i), Qlambda))
565 prefix = subprefix_stack[--submenu_depth];
566 i++;
568 else if (EQ (AREF (vector, i), Qt))
570 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
571 i += MENU_ITEMS_PANE_LENGTH;
573 else
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)
580 int j;
581 struct input_event buf;
582 Lisp_Object frame;
583 EVENT_INIT (buf);
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);
591 for (j = 0; j < submenu_depth; j++)
592 if (!NILP (subprefix_stack[j]))
594 buf.kind = MENU_BAR_EVENT;
595 buf.frame_or_window = frame;
596 buf.arg = subprefix_stack[j];
597 kbd_buffer_store_event (&buf);
600 if (!NILP (prefix))
602 buf.kind = MENU_BAR_EVENT;
603 buf.frame_or_window = frame;
604 buf.arg = prefix;
605 kbd_buffer_store_event (&buf);
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);
615 f->output_data.w32->menubar_active = 0;
616 return;
618 i += MENU_ITEMS_ITEM_LENGTH;
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;
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. */
631 void
632 set_frame_menubar (f, first_time, deep_p)
633 FRAME_PTR f;
634 int first_time;
635 int deep_p;
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;
644 /* We must not change the menubar when actually in use. */
645 if (f->output_data.w32->menubar_active)
646 return;
648 XSETFRAME (Vmenu_updating_frame, f);
650 if (! menubar_widget)
651 deep_p = 1;
652 else if (pending_menu_activation && !deep_p)
653 deep_p = 1;
655 if (deep_p)
657 /* Make a widget-value tree representing the entire menu trees. */
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));
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;
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);
678 record_unwind_save_match_data ();
680 if (NILP (Voverriding_local_map_menu_flag))
682 specbind (Qoverriding_terminal_local_map, Qnil);
683 specbind (Qoverriding_local_map, Qnil);
686 set_buffer_internal_1 (XBUFFER (buffer));
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));
697 items = FRAME_MENU_BAR_ITEMS (f);
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));
704 /* Fill in menu_items with the current menu bar contents.
705 This can evaluate Lisp code. */
706 save_menu_items ();
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)
718 Lisp_Object key, string, maps;
720 last_i = i;
722 key = AREF (items, i);
723 string = AREF (items, i + 1);
724 maps = AREF (items, i + 2);
725 if (NILP (string))
726 break;
728 submenu_start[i] = menu_items_used;
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;
735 submenu_end[i] = menu_items_used;
738 finish_menu_items ();
740 /* Convert menu_items into widget_value trees
741 to display the menu. This cannot evaluate Lisp code. */
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;
751 for (i = 0; i < last_i; i += 4)
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;
766 set_buffer_internal_1 (prev);
768 /* If there has been no change in the Lisp-level contents
769 of the menu bar, skip redisplaying it. Just exit. */
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)
777 free_menubar_widget_value_tree (first_wv);
778 discard_menu_items ();
779 unbind_to (specpdl_count, Qnil);
780 return;
783 f->menu_bar_vector = menu_items;
784 f->menu_bar_items_used = menu_items_used;
786 /* This undoes save_menu_items. */
787 unbind_to (specpdl_count, Qnil);
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)
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;
806 else
808 /* Make a widget-value tree containing
809 just the top level menu bar strings. */
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;
819 items = FRAME_MENU_BAR_ITEMS (f);
820 for (i = 0; i < ASIZE (items); i += 4)
822 Lisp_Object string;
824 string = AREF (items, i + 1);
825 if (NILP (string))
826 break;
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);
840 if (prev_wv)
841 prev_wv->next = wv;
842 else
843 first_wv->contents = wv;
844 prev_wv = wv;
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;
853 /* Create or update the menu bar widget. */
855 BLOCK_INPUT;
857 if (menubar_widget)
859 /* Empty current menubar, rather than creating a fresh one. */
860 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
863 else
865 menubar_widget = CreateMenu ();
867 fill_in_menu (menubar_widget, first_wv->contents);
869 free_menubar_widget_value_tree (first_wv);
872 HMENU old_widget = f->output_data.w32->menubar_widget;
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)); */
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));
885 UNBLOCK_INPUT;
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. */
893 void
894 initialize_frame_menubar (f)
895 FRAME_PTR f;
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);
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. */
906 void
907 free_frame_menubar (f)
908 FRAME_PTR f;
910 BLOCK_INPUT;
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);
919 UNBLOCK_INPUT;
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. */
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.) */
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;
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;
960 *error = NULL;
962 if (menu_items_n_panes == 0)
963 return Qnil;
965 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
967 *error = "Empty menu";
968 return Qnil;
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;
982 /* Loop over all panes and items, filling in the tree. */
983 i = 0;
984 while (i < menu_items_used)
986 if (EQ (AREF (menu_items, i), Qnil))
988 submenu_stack[submenu_depth++] = save_wv;
989 save_wv = prev_wv;
990 prev_wv = 0;
991 first_pane = 1;
992 i++;
994 else if (EQ (AREF (menu_items, i), Qlambda))
996 prev_wv = save_wv;
997 save_wv = submenu_stack[--submenu_depth];
998 first_pane = 0;
999 i++;
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))
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);
1016 if (STRINGP (pane_name))
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);
1023 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
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 = "";
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, ""))
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;
1053 else if (first_pane)
1055 save_wv = wv;
1056 prev_wv = 0;
1058 first_pane = 0;
1059 i += MENU_ITEMS_PANE_LENGTH;
1061 else
1063 /* Create a new item within current pane. */
1064 Lisp_Object item_name, enable, descrip, def, type, selected, help;
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);
1074 if (STRINGP (item_name))
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);
1081 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1084 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1086 descrip = ENCODE_SYSTEM (descrip);
1087 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
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);
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 ();
1113 wv->selected = !NILP (selected);
1115 if (!STRINGP (help))
1116 help = Qnil;
1118 wv->help = help;
1120 prev_wv = wv;
1122 i += MENU_ITEMS_ITEM_LENGTH;
1126 /* Deal with the title, if it is non-nil. */
1127 if (!NILP (title))
1129 widget_value *wv_title = xmalloc_widget_value ();
1130 widget_value *wv_sep = xmalloc_widget_value ();
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;
1138 if (unicode_append_menu)
1139 title = ENCODE_UTF_8 (title);
1140 else if (STRING_MULTIBYTE (title))
1141 title = ENCODE_SYSTEM (title);
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;
1152 /* No selection has been chosen yet. */
1153 menu_item_selection = 0;
1155 /* Actually create the menu. */
1156 current_popup_menu = menu = CreatePopupMenu ();
1157 fill_in_menu (menu, first_wv->contents);
1159 /* Adjust coordinates to be root-window-relative. */
1160 pos.x = x;
1161 pos.y = y;
1162 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1164 /* Display the menu. */
1165 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1166 WM_EMACS_TRACKPOPUPMENU,
1167 (WPARAM)menu, (LPARAM)&pos);
1169 /* Clean up extraneous mouse events which might have been generated
1170 during the call. */
1171 discard_mouse_events ();
1173 /* Free the widget_value objects we used to specify the contents. */
1174 free_menubar_widget_value_tree (first_wv);
1176 DestroyMenu (menu);
1178 /* Free the owner-drawn and help-echo menu strings. */
1179 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1180 f->output_data.w32->menubar_active = 0;
1182 /* Find the selected item, and its pane, to return
1183 the proper value. */
1184 if (menu_item_selection != 0)
1186 Lisp_Object prefix, entry;
1188 prefix = entry = Qnil;
1189 i = 0;
1190 while (i < menu_items_used)
1192 if (EQ (AREF (menu_items, i), Qnil))
1194 subprefix_stack[submenu_depth++] = prefix;
1195 prefix = entry;
1196 i++;
1198 else if (EQ (AREF (menu_items, i), Qlambda))
1200 prefix = subprefix_stack[--submenu_depth];
1201 i++;
1203 else if (EQ (AREF (menu_items, i), Qt))
1205 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1206 i += MENU_ITEMS_PANE_LENGTH;
1208 /* Ignore a nil in the item list.
1209 It's meaningful only for dialog boxes. */
1210 else if (EQ (AREF (menu_items, i), Qquote))
1211 i += 1;
1212 else
1214 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1215 if (menu_item_selection == i)
1217 if (keymaps != 0)
1219 int j;
1221 entry = Fcons (entry, Qnil);
1222 if (!NILP (prefix))
1223 entry = Fcons (prefix, entry);
1224 for (j = submenu_depth - 1; j >= 0; j--)
1225 if (!NILP (subprefix_stack[j]))
1226 entry = Fcons (subprefix_stack[j], entry);
1228 return entry;
1230 i += MENU_ITEMS_ITEM_LENGTH;
1234 else if (!for_click)
1235 /* Make "Cancel" equivalent to C-g. */
1236 Fsignal (Qquit, Qnil);
1238 return Qnil;
1242 #ifdef HAVE_DIALOGS
1243 /* TODO: On Windows, there are two ways of defining a dialog.
1245 1. Create a predefined dialog resource and include it in nt/emacs.rc.
1246 Using this method, we could then set the titles and make unneeded
1247 buttons invisible before displaying the dialog. Everything would
1248 be a fixed size though, so there is a risk that text does not
1249 fit on a button.
1250 2. Create the dialog template in memory on the fly. This allows us
1251 to size the dialog and buttons dynamically, probably giving more
1252 natural looking results for dialogs with few buttons, and eliminating
1253 the problem of text overflowing the buttons. But the API for this is
1254 quite complex - structures have to be allocated in particular ways,
1255 text content is tacked onto the end of structures in variable length
1256 arrays with further structures tacked on after these, there are
1257 certain alignment requirements for all this, and we have to
1258 measure all the text and convert to "dialog coordinates" to figure
1259 out how big to make everything.
1261 For now, we'll just stick with menus for dialogs that are more
1262 complicated than simple yes/no type questions for which we can use
1263 the MessageBox function.
1266 static char * button_names [] = {
1267 "button1", "button2", "button3", "button4", "button5",
1268 "button6", "button7", "button8", "button9", "button10" };
1270 static Lisp_Object
1271 w32_dialog_show (f, keymaps, title, header, error)
1272 FRAME_PTR f;
1273 int keymaps;
1274 Lisp_Object title, header;
1275 char **error;
1277 int i, nb_buttons=0;
1278 char dialog_name[6];
1279 int menu_item_selection;
1281 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1283 /* Number of elements seen so far, before boundary. */
1284 int left_count = 0;
1285 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1286 int boundary_seen = 0;
1288 *error = NULL;
1290 if (menu_items_n_panes > 1)
1292 *error = "Multiple panes in dialog box";
1293 return Qnil;
1296 /* Create a tree of widget_value objects
1297 representing the text label and buttons. */
1299 Lisp_Object pane_name, prefix;
1300 char *pane_string;
1301 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
1302 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
1303 pane_string = (NILP (pane_name)
1304 ? "" : (char *) SDATA (pane_name));
1305 prev_wv = xmalloc_widget_value ();
1306 prev_wv->value = pane_string;
1307 if (keymaps && !NILP (prefix))
1308 prev_wv->name++;
1309 prev_wv->enabled = 1;
1310 prev_wv->name = "message";
1311 prev_wv->help = Qnil;
1312 first_wv = prev_wv;
1314 /* Loop over all panes and items, filling in the tree. */
1315 i = MENU_ITEMS_PANE_LENGTH;
1316 while (i < menu_items_used)
1319 /* Create a new item within current pane. */
1320 Lisp_Object item_name, enable, descrip, help;
1322 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1323 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1324 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1325 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1327 if (NILP (item_name))
1329 free_menubar_widget_value_tree (first_wv);
1330 *error = "Submenu in dialog items";
1331 return Qnil;
1333 if (EQ (item_name, Qquote))
1335 /* This is the boundary between left-side elts
1336 and right-side elts. Stop incrementing right_count. */
1337 boundary_seen = 1;
1338 i++;
1339 continue;
1341 if (nb_buttons >= 9)
1343 free_menubar_widget_value_tree (first_wv);
1344 *error = "Too many dialog items";
1345 return Qnil;
1348 wv = xmalloc_widget_value ();
1349 prev_wv->next = wv;
1350 wv->name = (char *) button_names[nb_buttons];
1351 if (!NILP (descrip))
1352 wv->key = (char *) SDATA (descrip);
1353 wv->value = (char *) SDATA (item_name);
1354 wv->call_data = (void *) &AREF (menu_items, i);
1355 wv->enabled = !NILP (enable);
1356 wv->help = Qnil;
1357 prev_wv = wv;
1359 if (! boundary_seen)
1360 left_count++;
1362 nb_buttons++;
1363 i += MENU_ITEMS_ITEM_LENGTH;
1366 /* If the boundary was not specified,
1367 by default put half on the left and half on the right. */
1368 if (! boundary_seen)
1369 left_count = nb_buttons - nb_buttons / 2;
1371 wv = xmalloc_widget_value ();
1372 wv->name = dialog_name;
1373 wv->help = Qnil;
1375 /* Frame title: 'Q' = Question, 'I' = Information.
1376 Can also have 'E' = Error if, one day, we want
1377 a popup for errors. */
1378 if (NILP(header))
1379 dialog_name[0] = 'Q';
1380 else
1381 dialog_name[0] = 'I';
1383 /* Dialog boxes use a really stupid name encoding
1384 which specifies how many buttons to use
1385 and how many buttons are on the right. */
1386 dialog_name[1] = '0' + nb_buttons;
1387 dialog_name[2] = 'B';
1388 dialog_name[3] = 'R';
1389 /* Number of buttons to put on the right. */
1390 dialog_name[4] = '0' + nb_buttons - left_count;
1391 dialog_name[5] = 0;
1392 wv->contents = first_wv;
1393 first_wv = wv;
1396 /* Actually create the dialog. */
1397 dialog_id = widget_id_tick++;
1398 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1399 f->output_data.w32->widget, 1, 0,
1400 dialog_selection_callback, 0);
1401 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
1403 /* Free the widget_value objects we used to specify the contents. */
1404 free_menubar_widget_value_tree (first_wv);
1406 /* No selection has been chosen yet. */
1407 menu_item_selection = 0;
1409 /* Display the menu. */
1410 lw_pop_up_all_widgets (dialog_id);
1412 /* Process events that apply to the menu. */
1413 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1415 lw_destroy_all_widgets (dialog_id);
1417 /* Find the selected item, and its pane, to return
1418 the proper value. */
1419 if (menu_item_selection != 0)
1421 Lisp_Object prefix;
1423 prefix = Qnil;
1424 i = 0;
1425 while (i < menu_items_used)
1427 Lisp_Object entry;
1429 if (EQ (AREF (menu_items, i), Qt))
1431 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1432 i += MENU_ITEMS_PANE_LENGTH;
1434 else
1436 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1437 if (menu_item_selection == i)
1439 if (keymaps != 0)
1441 entry = Fcons (entry, Qnil);
1442 if (!NILP (prefix))
1443 entry = Fcons (prefix, entry);
1445 return entry;
1447 i += MENU_ITEMS_ITEM_LENGTH;
1451 else
1452 /* Make "Cancel" equivalent to C-g. */
1453 Fsignal (Qquit, Qnil);
1455 return Qnil;
1457 #else /* !HAVE_DIALOGS */
1459 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
1460 simple dialogs. We could handle a few more, but I'm not aware of
1461 anywhere in Emacs that uses the other specific dialog choices that
1462 MessageBox provides. */
1464 static int is_simple_dialog (contents)
1465 Lisp_Object contents;
1467 Lisp_Object options = XCDR (contents);
1468 Lisp_Object name, yes, no, other;
1470 yes = build_string ("Yes");
1471 no = build_string ("No");
1473 if (!CONSP (options))
1474 return 0;
1476 name = XCAR (XCAR (options));
1477 if (!CONSP (options))
1478 return 0;
1480 if (!NILP (Fstring_equal (name, yes)))
1481 other = no;
1482 else if (!NILP (Fstring_equal (name, no)))
1483 other = yes;
1484 else
1485 return 0;
1487 options = XCDR (options);
1488 if (!CONSP (options))
1489 return 0;
1491 name = XCAR (XCAR (options));
1492 if (NILP (Fstring_equal (name, other)))
1493 return 0;
1495 /* Check there are no more options. */
1496 options = XCDR (options);
1497 return !(CONSP (options));
1500 static Lisp_Object simple_dialog_show (f, contents, header)
1501 FRAME_PTR f;
1502 Lisp_Object contents, header;
1504 int answer;
1505 UINT type;
1506 char *text, *title;
1507 Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
1509 if (STRINGP (temp))
1510 text = SDATA (temp);
1511 else
1512 text = "";
1514 if (NILP (header))
1516 title = "Question";
1517 type = MB_ICONQUESTION;
1519 else
1521 title = "Information";
1522 type = MB_ICONINFORMATION;
1524 type |= MB_YESNO;
1526 /* Since we only handle Yes/No dialogs, and we already checked
1527 is_simple_dialog, we don't need to worry about checking contents
1528 to see what type of dialog to use. */
1529 answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
1531 if (answer == IDYES)
1532 lispy_answer = build_string ("Yes");
1533 else if (answer == IDNO)
1534 lispy_answer = build_string ("No");
1535 else
1536 Fsignal (Qquit, Qnil);
1538 for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
1540 Lisp_Object item, name, value;
1541 item = XCAR (temp);
1542 if (CONSP (item))
1544 name = XCAR (item);
1545 value = XCDR (item);
1547 else
1549 name = item;
1550 value = Qnil;
1553 if (!NILP (Fstring_equal (name, lispy_answer)))
1555 return value;
1558 Fsignal (Qquit, Qnil);
1559 return Qnil;
1561 #endif /* !HAVE_DIALOGS */
1564 /* Is this item a separator? */
1565 static int
1566 name_is_separator (name)
1567 char *name;
1569 char *start = name;
1571 /* Check if name string consists of only dashes ('-'). */
1572 while (*name == '-') name++;
1573 /* Separators can also be of the form "--:TripleSuperMegaEtched"
1574 or "--deep-shadow". We don't implement them yet, se we just treat
1575 them like normal separators. */
1576 return (*name == '\0' || start + 2 == name);
1580 /* Indicate boundary between left and right. */
1581 static int
1582 add_left_right_boundary (HMENU menu)
1584 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
1587 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
1588 static void
1589 utf8to16 (unsigned char * src, int len, WCHAR * dest)
1591 while (len > 0)
1593 int utf16;
1594 if (*src < 0x80)
1596 *dest = (WCHAR) *src;
1597 dest++; src++; len--;
1599 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
1600 else if (*src < 0xC0)
1602 src++; len--;
1604 /* 2 char UTF-8 sequence. */
1605 else if (*src < 0xE0)
1607 *dest = (WCHAR) (((*src & 0x1f) << 6)
1608 | (*(src + 1) & 0x3f));
1609 src += 2; len -= 2; dest++;
1611 else if (*src < 0xF0)
1613 *dest = (WCHAR) (((*src & 0x0f) << 12)
1614 | ((*(src + 1) & 0x3f) << 6)
1615 | (*(src + 2) & 0x3f));
1616 src += 3; len -= 3; dest++;
1618 else /* Not encodable. Insert Unicode Substitution char. */
1620 *dest = (WCHAR) 0xfffd;
1621 src++; len--; dest++;
1624 *dest = 0;
1627 static int
1628 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
1630 UINT fuFlags;
1631 char *out_string, *p, *q;
1632 int return_value;
1633 size_t nlen, orig_len;
1635 if (name_is_separator (wv->name))
1637 fuFlags = MF_SEPARATOR;
1638 out_string = NULL;
1640 else
1642 if (wv->enabled)
1643 fuFlags = MF_STRING;
1644 else
1645 fuFlags = MF_STRING | MF_GRAYED;
1647 if (wv->key != NULL)
1649 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
1650 strcpy (out_string, wv->name);
1651 strcat (out_string, "\t");
1652 strcat (out_string, wv->key);
1654 else
1655 out_string = wv->name;
1657 /* Quote any special characters within the menu item's text and
1658 key binding. */
1659 nlen = orig_len = strlen (out_string);
1660 if (unicode_append_menu)
1662 /* With UTF-8, & cannot be part of a multibyte character. */
1663 for (p = out_string; *p; p++)
1665 if (*p == '&')
1666 nlen++;
1669 else
1671 /* If encoded with the system codepage, use multibyte string
1672 functions in case of multibyte characters that contain '&'. */
1673 for (p = out_string; *p; p = _mbsinc (p))
1675 if (_mbsnextc (p) == '&')
1676 nlen++;
1680 if (nlen > orig_len)
1682 p = out_string;
1683 out_string = alloca (nlen + 1);
1684 q = out_string;
1685 while (*p)
1687 if (unicode_append_menu)
1689 if (*p == '&')
1690 *q++ = *p;
1691 *q++ = *p++;
1693 else
1695 if (_mbsnextc (p) == '&')
1697 _mbsncpy (q, p, 1);
1698 q = _mbsinc (q);
1700 _mbsncpy (q, p, 1);
1701 p = _mbsinc (p);
1702 q = _mbsinc (q);
1705 *q = '\0';
1708 if (item != NULL)
1709 fuFlags = MF_POPUP;
1710 else if (wv->title || wv->call_data == 0)
1712 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
1713 we can't deallocate the memory otherwise. */
1714 if (get_menu_item_info)
1716 out_string = (char *) local_alloc (strlen (wv->name) + 1);
1717 strcpy (out_string, wv->name);
1718 #ifdef MENU_DEBUG
1719 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
1720 #endif
1721 fuFlags = MF_OWNERDRAW | MF_DISABLED;
1723 else
1724 fuFlags = MF_DISABLED;
1727 /* Draw radio buttons and tickboxes. */
1728 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
1729 wv->button_type == BUTTON_TYPE_RADIO))
1730 fuFlags |= MF_CHECKED;
1731 else
1732 fuFlags |= MF_UNCHECKED;
1735 if (unicode_append_menu && out_string)
1737 /* Convert out_string from UTF-8 to UTF-16-LE. */
1738 int utf8_len = strlen (out_string);
1739 WCHAR * utf16_string;
1740 if (fuFlags & MF_OWNERDRAW)
1741 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
1742 else
1743 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
1745 utf8to16 (out_string, utf8_len, utf16_string);
1746 return_value = unicode_append_menu (menu, fuFlags,
1747 item != NULL ? (UINT) item
1748 : (UINT) wv->call_data,
1749 utf16_string);
1750 if (!return_value)
1752 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
1753 apparently does exist at least in some cases and appears to be
1754 stubbed out to do nothing. out_string is UTF-8, but since
1755 our standard menus are in English and this is only going to
1756 happen the first time a menu is used, the encoding is
1757 of minor importance compared with menus not working at all. */
1758 return_value =
1759 AppendMenu (menu, fuFlags,
1760 item != NULL ? (UINT) item: (UINT) wv->call_data,
1761 out_string);
1762 /* Don't use unicode menus in future. */
1763 unicode_append_menu = NULL;
1766 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
1767 local_free (out_string);
1769 else
1771 return_value =
1772 AppendMenu (menu,
1773 fuFlags,
1774 item != NULL ? (UINT) item : (UINT) wv->call_data,
1775 out_string );
1778 /* This must be done after the menu item is created. */
1779 if (!wv->title && wv->call_data != 0)
1781 if (set_menu_item_info)
1783 MENUITEMINFO info;
1784 bzero (&info, sizeof (info));
1785 info.cbSize = sizeof (info);
1786 info.fMask = MIIM_DATA;
1788 /* Set help string for menu item. Leave it as a Lisp_Object
1789 until it is ready to be displayed, since GC can happen while
1790 menus are active. */
1791 if (!NILP (wv->help))
1792 #ifdef USE_LISP_UNION_TYPE
1793 info.dwItemData = (DWORD) (wv->help).i;
1794 #else
1795 info.dwItemData = (DWORD) (wv->help);
1796 #endif
1797 if (wv->button_type == BUTTON_TYPE_RADIO)
1799 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
1800 RADIO items, but is not available on NT 3.51 and earlier. */
1801 info.fMask |= MIIM_TYPE | MIIM_STATE;
1802 info.fType = MFT_RADIOCHECK | MFT_STRING;
1803 info.dwTypeData = out_string;
1804 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
1807 set_menu_item_info (menu,
1808 item != NULL ? (UINT) item : (UINT) wv->call_data,
1809 FALSE, &info);
1812 return return_value;
1815 /* Construct native Windows menu(bar) based on widget_value tree. */
1817 fill_in_menu (HMENU menu, widget_value *wv)
1819 int items_added = 0;
1821 for ( ; wv != NULL; wv = wv->next)
1823 if (wv->contents)
1825 HMENU sub_menu = CreatePopupMenu ();
1827 if (sub_menu == NULL)
1828 return 0;
1830 if (!fill_in_menu (sub_menu, wv->contents) ||
1831 !add_menu_item (menu, wv, sub_menu))
1833 DestroyMenu (sub_menu);
1834 return 0;
1837 else
1839 if (!add_menu_item (menu, wv, NULL))
1840 return 0;
1843 return 1;
1846 /* Display help string for currently pointed to menu item. Not
1847 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
1848 available. */
1849 void
1850 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
1852 if (get_menu_item_info)
1854 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
1855 Lisp_Object frame, help;
1857 /* No help echo on owner-draw menu items, or when the keyboard is used
1858 to navigate the menus, since tooltips are distracting if they pop
1859 up elsewhere. */
1860 if (flags & MF_OWNERDRAW || flags & MF_POPUP
1861 || !(flags & MF_MOUSESELECT))
1862 help = Qnil;
1863 else
1865 MENUITEMINFO info;
1867 bzero (&info, sizeof (info));
1868 info.cbSize = sizeof (info);
1869 info.fMask = MIIM_DATA;
1870 get_menu_item_info (menu, item, FALSE, &info);
1872 #ifdef USE_LISP_UNION_TYPE
1873 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
1874 : Qnil;
1875 #else
1876 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
1877 #endif
1880 /* Store the help echo in the keyboard buffer as the X toolkit
1881 version does, rather than directly showing it. This seems to
1882 solve the GC problems that were present when we based the
1883 Windows code on the non-toolkit version. */
1884 if (f)
1886 XSETFRAME (frame, f);
1887 kbd_buffer_store_help_event (frame, help);
1889 else
1890 /* X version has a loop through frames here, which doesn't
1891 appear to do anything, unless it has some side effect. */
1892 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1896 /* Free memory used by owner-drawn strings. */
1897 static void
1898 w32_free_submenu_strings (menu)
1899 HMENU menu;
1901 int i, num = GetMenuItemCount (menu);
1902 for (i = 0; i < num; i++)
1904 MENUITEMINFO info;
1905 bzero (&info, sizeof (info));
1906 info.cbSize = sizeof (info);
1907 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
1909 get_menu_item_info (menu, i, TRUE, &info);
1911 /* Owner-drawn names are held in dwItemData. */
1912 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
1914 #ifdef MENU_DEBUG
1915 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
1916 #endif
1917 local_free (info.dwItemData);
1920 /* Recurse down submenus. */
1921 if (info.hSubMenu)
1922 w32_free_submenu_strings (info.hSubMenu);
1926 void
1927 w32_free_menu_strings (hwnd)
1928 HWND hwnd;
1930 HMENU menu = current_popup_menu;
1932 if (get_menu_item_info)
1934 /* If there is no popup menu active, free the strings from the frame's
1935 menubar. */
1936 if (!menu)
1937 menu = GetMenu (hwnd);
1939 if (menu)
1940 w32_free_submenu_strings (menu);
1943 current_popup_menu = NULL;
1946 #endif /* HAVE_MENUS */
1948 /* The following is used by delayed window autoselection. */
1950 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
1951 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
1954 #ifdef HAVE_MENUS
1955 FRAME_PTR f;
1956 f = SELECTED_FRAME ();
1957 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
1958 #else
1959 return Qnil;
1960 #endif /* HAVE_MENUS */
1963 void syms_of_w32menu ()
1965 globals_of_w32menu ();
1967 current_popup_menu = NULL;
1969 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
1971 defsubr (&Sx_popup_menu);
1972 defsubr (&Smenu_or_popup_active_p);
1973 #ifdef HAVE_MENUS
1974 defsubr (&Sx_popup_dialog);
1975 #endif
1979 globals_of_w32menu is used to initialize those global variables that
1980 must always be initialized on startup even when the global variable
1981 initialized is non zero (see the function main in emacs.c).
1982 globals_of_w32menu is called from syms_of_w32menu when the global
1983 variable initialized is 0 and directly from main when initialized
1984 is non zero.
1986 void globals_of_w32menu ()
1988 /* See if Get/SetMenuItemInfo functions are available. */
1989 HMODULE user32 = GetModuleHandle ("user32.dll");
1990 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
1991 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
1992 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
1995 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
1996 (do not change this comment) */