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