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