* subr.el (assoc-default): Doc fix.
[emacs.git] / src / w32menu.c
blob677de1b180a1ec9666df784c5906080678a7fbf4
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, 2009
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));
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.
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>. */
114 int pending_menu_activation;
117 /* Return the frame whose ->output_data.w32->menubar_widget equals
118 ID, or 0 if none. */
120 static struct frame *
121 menubar_id_to_frame (id)
122 HMENU id;
124 Lisp_Object tail, frame;
125 FRAME_PTR f;
127 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
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;
138 return 0;
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.
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.
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.
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.
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.
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;
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;
188 #ifdef HAVE_MENUS
189 if (! NILP (position))
191 check_w32 ();
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))))
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;
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
211 window = selected_window;
212 XSETFASTINT (x, 0);
213 XSETFASTINT (y, 0);
216 else
218 tem = Fcar (position);
219 if (CONSP (tem))
221 window = Fcar (Fcdr (position));
222 x = Fcar (tem);
223 y = Fcar (Fcdr (tem));
225 else
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);
236 CHECK_NUMBER (x);
237 CHECK_NUMBER (y);
239 /* Decode where to put the menu. */
241 if (FRAMEP (window))
243 f = XFRAME (window);
244 xpos = 0;
245 ypos = 0;
247 else if (WINDOWP (window))
249 CHECK_LIVE_WINDOW (window);
250 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
252 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
253 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
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);
260 xpos += XINT (x);
261 ypos += XINT (y);
263 XSETFRAME (Vmenu_updating_frame, f);
265 else
266 Vmenu_updating_frame = Qnil;
267 #endif /* HAVE_MENUS */
269 record_unwind_protect (unuse_menu_items, Qnil);
271 title = Qnil;
272 GCPRO1 (title);
274 /* Decode the menu items from what was specified. */
276 keymap = get_keymap (menu, 0, 0);
277 if (CONSP (keymap))
279 /* We were given a keymap. Extract menu info from the keymap. */
280 Lisp_Object prompt;
282 /* Extract the detailed info to make one pane. */
283 keymap_panes (&menu, 1, NILP (position));
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;
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);
295 keymaps = 1;
297 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
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;
305 title = Qnil;
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))
311 Lisp_Object prompt;
313 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
315 prompt = Fkeymap_prompt (keymap);
316 if (NILP (title) && !NILP (prompt))
317 title = prompt;
320 /* Extract the detailed info to make one pane. */
321 keymap_panes (maps, nmaps, NILP (position));
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);
327 keymaps = 1;
329 else
331 /* We were given an old-fashioned menu. */
332 title = Fcar (menu);
333 CHECK_STRING (title);
335 list_of_panes (Fcdr (menu));
337 keymaps = 0;
340 unbind_to (specpdl_count, Qnil);
342 if (NILP (position))
344 discard_menu_items ();
345 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
346 UNGCPRO;
347 return Qnil;
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.
356 if (current_popup_menu)
358 discard_menu_items ();
359 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
360 UNGCPRO;
361 return Qnil;
364 /* Display them in a menu. */
365 BLOCK_INPUT;
367 selection = w32_menu_show (f, xpos, ypos, for_click,
368 keymaps, title, &error_name);
369 UNBLOCK_INPUT;
371 discard_menu_items ();
372 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
374 #endif /* HAVE_MENUS */
376 UNGCPRO;
378 if (error_name) error (error_name);
379 return selection;
382 #ifdef HAVE_MENUS
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.
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.
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.)
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;
406 FRAME_PTR f = NULL;
407 Lisp_Object window;
409 check_w32 ();
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))))
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;
424 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
426 if (new_f != 0)
427 XSETFRAME (window, new_f);
428 else
429 window = selected_window;
430 #endif
431 window = selected_window;
433 else if (CONSP (position))
435 Lisp_Object tem;
436 tem = Fcar (position);
437 if (CONSP (tem))
438 window = Fcar (Fcdr (position));
439 else
441 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
442 window = Fcar (tem); /* POSN_WINDOW (tem) */
445 else if (WINDOWP (position) || FRAMEP (position))
446 window = position;
447 else
448 window = Qnil;
450 /* Decode where to put the menu. */
452 if (FRAMEP (window))
453 f = XFRAME (window);
454 else if (WINDOWP (window))
456 CHECK_LIVE_WINDOW (window);
457 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
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);
464 #ifndef HAVE_DIALOGS
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
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)));
483 #else /* HAVE_DIALOGS */
485 Lisp_Object title;
486 char *error_name;
487 Lisp_Object selection;
489 /* Decode the dialog items from what was specified. */
490 title = Fcar (contents);
491 CHECK_STRING (title);
493 list_of_panes (Fcons (contents, Qnil));
495 /* Display them in a dialog box. */
496 BLOCK_INPUT;
497 selection = w32_dialog_show (f, 0, title, header, &error_name);
498 UNBLOCK_INPUT;
500 discard_menu_items ();
501 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
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 ();
1172 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1174 /* Free the widget_value objects we used to specify the contents. */
1175 free_menubar_widget_value_tree (first_wv);
1177 DestroyMenu (menu);
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;
1183 /* Find the selected item, and its pane, to return
1184 the proper value. */
1185 if (menu_item_selection != 0)
1187 Lisp_Object prefix, entry;
1189 prefix = entry = Qnil;
1190 i = 0;
1191 while (i < menu_items_used)
1193 if (EQ (AREF (menu_items, i), Qnil))
1195 subprefix_stack[submenu_depth++] = prefix;
1196 prefix = entry;
1197 i++;
1199 else if (EQ (AREF (menu_items, i), Qlambda))
1201 prefix = subprefix_stack[--submenu_depth];
1202 i++;
1204 else if (EQ (AREF (menu_items, i), Qt))
1206 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1207 i += MENU_ITEMS_PANE_LENGTH;
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
1215 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1216 if (menu_item_selection == i)
1218 if (keymaps != 0)
1220 int j;
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);
1229 return entry;
1231 i += MENU_ITEMS_ITEM_LENGTH;
1235 else if (!for_click)
1236 /* Make "Cancel" equivalent to C-g. */
1237 Fsignal (Qquit, Qnil);
1239 return Qnil;
1243 #ifdef HAVE_DIALOGS
1244 /* TODO: On Windows, there are two ways of defining a dialog.
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.
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.
1267 static char * button_names [] = {
1268 "button1", "button2", "button3", "button4", "button5",
1269 "button6", "button7", "button8", "button9", "button10" };
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;
1278 int i, nb_buttons=0;
1279 char dialog_name[6];
1280 int menu_item_selection;
1282 widget_value *wv, *first_wv = 0, *prev_wv = 0;
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;
1289 *error = NULL;
1291 if (menu_items_n_panes > 1)
1293 *error = "Multiple panes in dialog box";
1294 return Qnil;
1297 /* Create a tree of widget_value objects
1298 representing the text label and buttons. */
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;
1315 /* Loop over all panes and items, filling in the tree. */
1316 i = MENU_ITEMS_PANE_LENGTH;
1317 while (i < menu_items_used)
1320 /* Create a new item within current pane. */
1321 Lisp_Object item_name, enable, descrip, help;
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);
1328 if (NILP (item_name))
1330 free_menubar_widget_value_tree (first_wv);
1331 *error = "Submenu in dialog items";
1332 return Qnil;
1334 if (EQ (item_name, Qquote))
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;
1342 if (nb_buttons >= 9)
1344 free_menubar_widget_value_tree (first_wv);
1345 *error = "Too many dialog items";
1346 return Qnil;
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;
1360 if (! boundary_seen)
1361 left_count++;
1363 nb_buttons++;
1364 i += MENU_ITEMS_ITEM_LENGTH;
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;
1372 wv = xmalloc_widget_value ();
1373 wv->name = dialog_name;
1374 wv->help = Qnil;
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';
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;
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);
1404 /* Free the widget_value objects we used to specify the contents. */
1405 free_menubar_widget_value_tree (first_wv);
1407 /* No selection has been chosen yet. */
1408 menu_item_selection = 0;
1410 /* Display the menu. */
1411 lw_pop_up_all_widgets (dialog_id);
1413 /* Process events that apply to the menu. */
1414 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1416 lw_destroy_all_widgets (dialog_id);
1418 /* Find the selected item, and its pane, to return
1419 the proper value. */
1420 if (menu_item_selection != 0)
1422 Lisp_Object prefix;
1424 prefix = Qnil;
1425 i = 0;
1426 while (i < menu_items_used)
1428 Lisp_Object entry;
1430 if (EQ (AREF (menu_items, i), Qt))
1432 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1433 i += MENU_ITEMS_PANE_LENGTH;
1435 else
1437 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1438 if (menu_item_selection == i)
1440 if (keymaps != 0)
1442 entry = Fcons (entry, Qnil);
1443 if (!NILP (prefix))
1444 entry = Fcons (prefix, entry);
1446 return entry;
1448 i += MENU_ITEMS_ITEM_LENGTH;
1452 else
1453 /* Make "Cancel" equivalent to C-g. */
1454 Fsignal (Qquit, Qnil);
1456 return Qnil;
1458 #else /* !HAVE_DIALOGS */
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. */
1465 static int is_simple_dialog (contents)
1466 Lisp_Object contents;
1468 Lisp_Object options = XCDR (contents);
1469 Lisp_Object name, yes, no, other;
1471 yes = build_string ("Yes");
1472 no = build_string ("No");
1474 if (!CONSP (options))
1475 return 0;
1477 name = XCAR (XCAR (options));
1478 if (!CONSP (options))
1479 return 0;
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;
1488 options = XCDR (options);
1489 if (!CONSP (options))
1490 return 0;
1492 name = XCAR (XCAR (options));
1493 if (NILP (Fstring_equal (name, other)))
1494 return 0;
1496 /* Check there are no more options. */
1497 options = XCDR (options);
1498 return !(CONSP (options));
1501 static Lisp_Object simple_dialog_show (f, contents, header)
1502 FRAME_PTR f;
1503 Lisp_Object contents, header;
1505 int answer;
1506 UINT type;
1507 char *text, *title;
1508 Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
1510 if (STRINGP (temp))
1511 text = SDATA (temp);
1512 else
1513 text = "";
1515 if (NILP (header))
1517 title = "Question";
1518 type = MB_ICONQUESTION;
1520 else
1522 title = "Information";
1523 type = MB_ICONINFORMATION;
1525 type |= MB_YESNO;
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);
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);
1539 for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
1541 Lisp_Object item, name, value;
1542 item = XCAR (temp);
1543 if (CONSP (item))
1545 name = XCAR (item);
1546 value = XCDR (item);
1548 else
1550 name = item;
1551 value = Qnil;
1554 if (!NILP (Fstring_equal (name, lispy_answer)))
1556 return value;
1559 Fsignal (Qquit, Qnil);
1560 return Qnil;
1562 #endif /* !HAVE_DIALOGS */
1565 /* Is this item a separator? */
1566 static int
1567 name_is_separator (name)
1568 char *name;
1570 char *start = name;
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);
1581 /* Indicate boundary between left and right. */
1582 static int
1583 add_left_right_boundary (HMENU menu)
1585 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
1588 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
1589 static void
1590 utf8to16 (unsigned char * src, int len, WCHAR * dest)
1592 while (len > 0)
1594 int utf16;
1595 if (*src < 0x80)
1597 *dest = (WCHAR) *src;
1598 dest++; src++; len--;
1600 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
1601 else if (*src < 0xC0)
1603 src++; len--;
1605 /* 2 char UTF-8 sequence. */
1606 else if (*src < 0xE0)
1608 *dest = (WCHAR) (((*src & 0x1f) << 6)
1609 | (*(src + 1) & 0x3f));
1610 src += 2; len -= 2; dest++;
1612 else if (*src < 0xF0)
1614 *dest = (WCHAR) (((*src & 0x0f) << 12)
1615 | ((*(src + 1) & 0x3f) << 6)
1616 | (*(src + 2) & 0x3f));
1617 src += 3; len -= 3; dest++;
1619 else /* Not encodable. Insert Unicode Substitution char. */
1621 *dest = (WCHAR) 0xfffd;
1622 src++; len--; dest++;
1625 *dest = 0;
1628 static int
1629 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
1631 UINT fuFlags;
1632 char *out_string, *p, *q;
1633 int return_value;
1634 size_t nlen, orig_len;
1636 if (name_is_separator (wv->name))
1638 fuFlags = MF_SEPARATOR;
1639 out_string = NULL;
1641 else
1643 if (wv->enabled)
1644 fuFlags = MF_STRING;
1645 else
1646 fuFlags = MF_STRING | MF_GRAYED;
1648 if (wv->key != NULL)
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);
1655 else
1656 out_string = wv->name;
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)
1663 /* With UTF-8, & cannot be part of a multibyte character. */
1664 for (p = out_string; *p; p++)
1666 if (*p == '&')
1667 nlen++;
1670 else
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))
1676 if (_mbsnextc (p) == '&')
1677 nlen++;
1681 if (nlen > orig_len)
1683 p = out_string;
1684 out_string = alloca (nlen + 1);
1685 q = out_string;
1686 while (*p)
1688 if (unicode_append_menu)
1690 if (*p == '&')
1691 *q++ = *p;
1692 *q++ = *p++;
1694 else
1696 if (_mbsnextc (p) == '&')
1698 _mbsncpy (q, p, 1);
1699 q = _mbsinc (q);
1701 _mbsncpy (q, p, 1);
1702 p = _mbsinc (p);
1703 q = _mbsinc (q);
1706 *q = '\0';
1709 if (item != NULL)
1710 fuFlags = MF_POPUP;
1711 else if (wv->title || wv->call_data == 0)
1713 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
1714 we can't deallocate the memory otherwise. */
1715 if (get_menu_item_info)
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;
1724 else
1725 fuFlags = MF_DISABLED;
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;
1736 if (unicode_append_menu && out_string)
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));
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)
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;
1767 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
1768 local_free (out_string);
1770 else
1772 return_value =
1773 AppendMenu (menu,
1774 fuFlags,
1775 item != NULL ? (UINT) item : (UINT) wv->call_data,
1776 out_string );
1779 /* This must be done after the menu item is created. */
1780 if (!wv->title && wv->call_data != 0)
1782 if (set_menu_item_info)
1784 MENUITEMINFO info;
1785 bzero (&info, sizeof (info));
1786 info.cbSize = sizeof (info);
1787 info.fMask = MIIM_DATA;
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)
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;
1808 set_menu_item_info (menu,
1809 item != NULL ? (UINT) item : (UINT) wv->call_data,
1810 FALSE, &info);
1813 return return_value;
1816 /* Construct native Windows menu(bar) based on widget_value tree. */
1818 fill_in_menu (HMENU menu, widget_value *wv)
1820 int items_added = 0;
1822 for ( ; wv != NULL; wv = wv->next)
1824 if (wv->contents)
1826 HMENU sub_menu = CreatePopupMenu ();
1828 if (sub_menu == NULL)
1829 return 0;
1831 if (!fill_in_menu (sub_menu, wv->contents) ||
1832 !add_menu_item (menu, wv, sub_menu))
1834 DestroyMenu (sub_menu);
1835 return 0;
1838 else
1840 if (!add_menu_item (menu, wv, NULL))
1841 return 0;
1844 return 1;
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)
1853 if (get_menu_item_info)
1855 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
1856 Lisp_Object frame, help;
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
1866 MENUITEMINFO info;
1868 bzero (&info, sizeof (info));
1869 info.cbSize = sizeof (info);
1870 info.fMask = MIIM_DATA;
1871 get_menu_item_info (menu, item, FALSE, &info);
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
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)
1887 XSETFRAME (frame, f);
1888 kbd_buffer_store_help_event (frame, help);
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);
1897 /* Free memory used by owner-drawn strings. */
1898 static void
1899 w32_free_submenu_strings (menu)
1900 HMENU menu;
1902 int i, num = GetMenuItemCount (menu);
1903 for (i = 0; i < num; i++)
1905 MENUITEMINFO info;
1906 bzero (&info, sizeof (info));
1907 info.cbSize = sizeof (info);
1908 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
1910 get_menu_item_info (menu, i, TRUE, &info);
1912 /* Owner-drawn names are held in dwItemData. */
1913 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
1915 #ifdef MENU_DEBUG
1916 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
1917 #endif
1918 local_free (info.dwItemData);
1921 /* Recurse down submenus. */
1922 if (info.hSubMenu)
1923 w32_free_submenu_strings (info.hSubMenu);
1927 void
1928 w32_free_menu_strings (hwnd)
1929 HWND hwnd;
1931 HMENU menu = current_popup_menu;
1933 if (get_menu_item_info)
1935 /* If there is no popup menu active, free the strings from the frame's
1936 menubar. */
1937 if (!menu)
1938 menu = GetMenu (hwnd);
1940 if (menu)
1941 w32_free_submenu_strings (menu);
1944 current_popup_menu = NULL;
1947 #endif /* HAVE_MENUS */
1949 /* The following is used by delayed window autoselection. */
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. */)
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 */
1964 void syms_of_w32menu ()
1966 globals_of_w32menu ();
1968 current_popup_menu = NULL;
1970 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
1972 defsubr (&Sx_popup_menu);
1973 defsubr (&Smenu_or_popup_active_p);
1974 #ifdef HAVE_MENUS
1975 defsubr (&Sx_popup_dialog);
1976 #endif
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.
1987 void globals_of_w32menu ()
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");
1996 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
1997 (do not change this comment) */