*** empty log message ***
[bpt/emacs.git] / src / w32menu.c
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986,88,93,94,96,98,1999,2003 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include <config.h>
22 #include <signal.h>
23
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "termhooks.h"
27 #include "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "blockinput.h"
32 #include "buffer.h"
33 #include "charset.h"
34 #include "coding.h"
35
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
38 #include "w32term.h"
39
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
42 #ifndef makedev
43 #include <sys/types.h>
44 #endif
45
46 #include "dispextern.h"
47
48 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
49
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
52
53 typedef void * XtPointer;
54 typedef char Boolean;
55
56 enum button_type
57 {
58 BUTTON_TYPE_NONE,
59 BUTTON_TYPE_TOGGLE,
60 BUTTON_TYPE_RADIO
61 };
62
63 /* This structure is based on the one in ../lwlib/lwlib.h, modified
64 for Windows. */
65 typedef struct _widget_value
66 {
67 /* name of widget */
68 Lisp_Object lname;
69 char* name;
70 /* value (meaning depend on widget type) */
71 char* value;
72 /* keyboard equivalent. no implications for XtTranslations */
73 Lisp_Object lkey;
74 char* key;
75 /* Help string or nil if none.
76 GC finds this string through the frame's menu_bar_vector
77 or through menu_items. */
78 Lisp_Object help;
79 /* true if enabled */
80 Boolean enabled;
81 /* true if selected */
82 Boolean selected;
83 /* The type of a button. */
84 enum button_type button_type;
85 /* true if menu title */
86 Boolean title;
87 #if 0
88 /* true if was edited (maintained by get_value) */
89 Boolean edited;
90 /* true if has changed (maintained by lw library) */
91 change_type change;
92 /* true if this widget itself has changed,
93 but not counting the other widgets found in the `next' field. */
94 change_type this_one_change;
95 #endif
96 /* Contents of the sub-widgets, also selected slot for checkbox */
97 struct _widget_value* contents;
98 /* data passed to callback */
99 XtPointer call_data;
100 /* next one in the list */
101 struct _widget_value* next;
102 #if 0
103 /* slot for the toolkit dependent part. Always initialize to NULL. */
104 void* toolkit_data;
105 /* tell us if we should free the toolkit data slot when freeing the
106 widget_value itself. */
107 Boolean free_toolkit_data;
108
109 /* we resource the widget_value structures; this points to the next
110 one on the free list if this one has been deallocated.
111 */
112 struct _widget_value *free_list;
113 #endif
114 } widget_value;
115
116 /* Local memory management */
117 #define local_heap (GetProcessHeap ())
118 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
119 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
120
121 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
122 #define free_widget_value(wv) (local_free ((wv)))
123
124 /******************************************************************/
125
126 #ifndef TRUE
127 #define TRUE 1
128 #define FALSE 0
129 #endif /* no TRUE */
130
131 static HMENU current_popup_menu;
132
133 void syms_of_w32menu ();
134 void globals_of_w32menu ();
135
136 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
137 IN HMENU,
138 IN UINT,
139 IN BOOL,
140 IN OUT LPMENUITEMINFOA);
141 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
142 IN HMENU,
143 IN UINT,
144 IN BOOL,
145 IN LPCMENUITEMINFOA);
146
147 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
148 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
149 AppendMenuW_Proc unicode_append_menu = NULL;
150
151 Lisp_Object Vmenu_updating_frame;
152
153 Lisp_Object Qdebug_on_next_call;
154
155 extern Lisp_Object Qmenu_bar;
156
157 extern Lisp_Object QCtoggle, QCradio;
158
159 extern Lisp_Object Voverriding_local_map;
160 extern Lisp_Object Voverriding_local_map_menu_flag;
161
162 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
163
164 extern Lisp_Object Qmenu_bar_update_hook;
165
166 void set_frame_menubar ();
167
168 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
169 Lisp_Object, Lisp_Object, Lisp_Object,
170 Lisp_Object, Lisp_Object));
171 #ifdef HAVE_DIALOGS
172 static Lisp_Object w32_dialog_show ();
173 #endif
174 static Lisp_Object w32_menu_show ();
175
176 static void keymap_panes ();
177 static void single_keymap_panes ();
178 static void single_menu_item ();
179 static void list_of_panes ();
180 static void list_of_items ();
181 void w32_free_menu_strings (HWND);
182 \f
183 /* This holds a Lisp vector that holds the results of decoding
184 the keymaps or alist-of-alists that specify a menu.
185
186 It describes the panes and items within the panes.
187
188 Each pane is described by 3 elements in the vector:
189 t, the pane name, the pane's prefix key.
190 Then follow the pane's items, with 5 elements per item:
191 the item string, the enable flag, the item's value,
192 the definition, and the equivalent keyboard key's description string.
193
194 In some cases, multiple levels of menus may be described.
195 A single vector slot containing nil indicates the start of a submenu.
196 A single vector slot containing lambda indicates the end of a submenu.
197 The submenu follows a menu item which is the way to reach the submenu.
198
199 A single vector slot containing quote indicates that the
200 following items should appear on the right of a dialog box.
201
202 Using a Lisp vector to hold this information while we decode it
203 takes care of protecting all the data from GC. */
204
205 #define MENU_ITEMS_PANE_NAME 1
206 #define MENU_ITEMS_PANE_PREFIX 2
207 #define MENU_ITEMS_PANE_LENGTH 3
208
209 enum menu_item_idx
210 {
211 MENU_ITEMS_ITEM_NAME = 0,
212 MENU_ITEMS_ITEM_ENABLE,
213 MENU_ITEMS_ITEM_VALUE,
214 MENU_ITEMS_ITEM_EQUIV_KEY,
215 MENU_ITEMS_ITEM_DEFINITION,
216 MENU_ITEMS_ITEM_TYPE,
217 MENU_ITEMS_ITEM_SELECTED,
218 MENU_ITEMS_ITEM_HELP,
219 MENU_ITEMS_ITEM_LENGTH
220 };
221
222 static Lisp_Object menu_items;
223
224 /* Number of slots currently allocated in menu_items. */
225 static int menu_items_allocated;
226
227 /* This is the index in menu_items of the first empty slot. */
228 static int menu_items_used;
229
230 /* The number of panes currently recorded in menu_items,
231 excluding those within submenus. */
232 static int menu_items_n_panes;
233
234 /* Current depth within submenus. */
235 static int menu_items_submenu_depth;
236
237 /* Flag which when set indicates a dialog or menu has been posted by
238 Xt on behalf of one of the widget sets. */
239 static int popup_activated_flag;
240
241 static int next_menubar_widget_id;
242
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
246
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249
250 int pending_menu_activation;
251 \f
252
253 /* Return the frame whose ->output_data.w32->menubar_widget equals
254 ID, or 0 if none. */
255
256 static struct frame *
257 menubar_id_to_frame (id)
258 HMENU id;
259 {
260 Lisp_Object tail, frame;
261 FRAME_PTR f;
262
263 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
264 {
265 frame = XCAR (tail);
266 if (!GC_FRAMEP (frame))
267 continue;
268 f = XFRAME (frame);
269 if (!FRAME_WINDOW_P (f))
270 continue;
271 if (f->output_data.w32->menubar_widget == id)
272 return f;
273 }
274 return 0;
275 }
276 \f
277 /* Initialize the menu_items structure if we haven't already done so.
278 Also mark it as currently empty. */
279
280 static void
281 init_menu_items ()
282 {
283 if (NILP (menu_items))
284 {
285 menu_items_allocated = 60;
286 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
287 }
288
289 menu_items_used = 0;
290 menu_items_n_panes = 0;
291 menu_items_submenu_depth = 0;
292 }
293
294 /* Call at the end of generating the data in menu_items.
295 This fills in the number of items in the last pane. */
296
297 static void
298 finish_menu_items ()
299 {
300 }
301
302 /* Call when finished using the data for the current menu
303 in menu_items. */
304
305 static void
306 discard_menu_items ()
307 {
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated > 200)
311 {
312 menu_items = Qnil;
313 menu_items_allocated = 0;
314 }
315 }
316
317 /* Make the menu_items vector twice as large. */
318
319 static void
320 grow_menu_items ()
321 {
322 Lisp_Object old;
323 int old_size = menu_items_allocated;
324 old = menu_items;
325
326 menu_items_allocated *= 2;
327 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
328 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
329 old_size * sizeof (Lisp_Object));
330 }
331
332 /* Begin a submenu. */
333
334 static void
335 push_submenu_start ()
336 {
337 if (menu_items_used + 1 > menu_items_allocated)
338 grow_menu_items ();
339
340 ASET (menu_items, menu_items_used++, Qnil);
341 menu_items_submenu_depth++;
342 }
343
344 /* End a submenu. */
345
346 static void
347 push_submenu_end ()
348 {
349 if (menu_items_used + 1 > menu_items_allocated)
350 grow_menu_items ();
351
352 ASET (menu_items, menu_items_used++, Qlambda);
353 menu_items_submenu_depth--;
354 }
355
356 /* Indicate boundary between left and right. */
357
358 static void
359 push_left_right_boundary ()
360 {
361 if (menu_items_used + 1 > menu_items_allocated)
362 grow_menu_items ();
363
364 ASET (menu_items, menu_items_used++, Qquote);
365 }
366
367 /* Start a new menu pane in menu_items.
368 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
369
370 static void
371 push_menu_pane (name, prefix_vec)
372 Lisp_Object name, prefix_vec;
373 {
374 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
375 grow_menu_items ();
376
377 if (menu_items_submenu_depth == 0)
378 menu_items_n_panes++;
379 ASET (menu_items, menu_items_used++, Qt);
380 ASET (menu_items, menu_items_used++, name);
381 ASET (menu_items, menu_items_used++, prefix_vec);
382 }
383
384 /* Push one menu item into the current pane. NAME is the string to
385 display. ENABLE if non-nil means this item can be selected. KEY
386 is the key generated by choosing this item, or nil if this item
387 doesn't really have a definition. DEF is the definition of this
388 item. EQUIV is the textual description of the keyboard equivalent
389 for this item (or nil if none). TYPE is the type of this menu
390 item, one of nil, `toggle' or `radio'. */
391
392 static void
393 push_menu_item (name, enable, key, def, equiv, type, selected, help)
394 Lisp_Object name, enable, key, def, equiv, type, selected, help;
395 {
396 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
397 grow_menu_items ();
398
399 ASET (menu_items, menu_items_used++, name);
400 ASET (menu_items, menu_items_used++, enable);
401 ASET (menu_items, menu_items_used++, key);
402 ASET (menu_items, menu_items_used++, equiv);
403 ASET (menu_items, menu_items_used++, def);
404 ASET (menu_items, menu_items_used++, type);
405 ASET (menu_items, menu_items_used++, selected);
406 ASET (menu_items, menu_items_used++, help);
407 }
408 \f
409 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
410 and generate menu panes for them in menu_items.
411 If NOTREAL is nonzero,
412 don't bother really computing whether an item is enabled. */
413
414 static void
415 keymap_panes (keymaps, nmaps, notreal)
416 Lisp_Object *keymaps;
417 int nmaps;
418 int notreal;
419 {
420 int mapno;
421
422 init_menu_items ();
423
424 /* Loop over the given keymaps, making a pane for each map.
425 But don't make a pane that is empty--ignore that map instead.
426 P is the number of panes we have made so far. */
427 for (mapno = 0; mapno < nmaps; mapno++)
428 single_keymap_panes (keymaps[mapno],
429 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
430
431 finish_menu_items ();
432 }
433
434 /* This is a recursive subroutine of keymap_panes.
435 It handles one keymap, KEYMAP.
436 The other arguments are passed along
437 or point to local variables of the previous function.
438 If NOTREAL is nonzero, only check for equivalent key bindings, don't
439 evaluate expressions in menu items and don't make any menu.
440
441 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
442
443 static void
444 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
445 Lisp_Object keymap;
446 Lisp_Object pane_name;
447 Lisp_Object prefix;
448 int notreal;
449 int maxdepth;
450 {
451 Lisp_Object pending_maps = Qnil;
452 Lisp_Object tail, item;
453 struct gcpro gcpro1, gcpro2;
454
455 if (maxdepth <= 0)
456 return;
457
458 push_menu_pane (pane_name, prefix);
459
460 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
461 {
462 GCPRO2 (keymap, pending_maps);
463 /* Look at each key binding, and if it is a menu item add it
464 to this menu. */
465 item = XCAR (tail);
466 if (CONSP (item))
467 single_menu_item (XCAR (item), XCDR (item),
468 &pending_maps, notreal, maxdepth);
469 else if (VECTORP (item))
470 {
471 /* Loop over the char values represented in the vector. */
472 int len = ASIZE (item);
473 int c;
474 for (c = 0; c < len; c++)
475 {
476 Lisp_Object character;
477 XSETFASTINT (character, c);
478 single_menu_item (character, AREF (item, c),
479 &pending_maps, notreal, maxdepth);
480 }
481 }
482 UNGCPRO;
483 }
484
485 /* Process now any submenus which want to be panes at this level. */
486 while (!NILP (pending_maps))
487 {
488 Lisp_Object elt, eltcdr, string;
489 elt = Fcar (pending_maps);
490 eltcdr = XCDR (elt);
491 string = XCAR (eltcdr);
492 /* We no longer discard the @ from the beginning of the string here.
493 Instead, we do this in w32_menu_show. */
494 single_keymap_panes (Fcar (elt), string,
495 XCDR (eltcdr), notreal, maxdepth - 1);
496 pending_maps = Fcdr (pending_maps);
497 }
498 }
499 \f
500 /* This is a subroutine of single_keymap_panes that handles one
501 keymap entry.
502 KEY is a key in a keymap and ITEM is its binding.
503 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
504 separate panes.
505 If NOTREAL is nonzero, only check for equivalent key bindings, don't
506 evaluate expressions in menu items and don't make any menu.
507 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
508
509 static void
510 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
511 Lisp_Object key, item;
512 Lisp_Object *pending_maps_ptr;
513 int maxdepth, notreal;
514 {
515 Lisp_Object map, item_string, enabled;
516 struct gcpro gcpro1, gcpro2;
517 int res;
518
519 /* Parse the menu item and leave the result in item_properties. */
520 GCPRO2 (key, item);
521 res = parse_menu_item (item, notreal, 0);
522 UNGCPRO;
523 if (!res)
524 return; /* Not a menu item. */
525
526 map = AREF (item_properties, ITEM_PROPERTY_MAP);
527
528 if (notreal)
529 {
530 /* We don't want to make a menu, just traverse the keymaps to
531 precompute equivalent key bindings. */
532 if (!NILP (map))
533 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
534 return;
535 }
536
537 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
538 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
539
540 if (!NILP (map) && SREF (item_string, 0) == '@')
541 {
542 if (!NILP (enabled))
543 /* An enabled separate pane. Remember this to handle it later. */
544 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
545 *pending_maps_ptr);
546 return;
547 }
548
549 push_menu_item (item_string, enabled, key,
550 AREF (item_properties, ITEM_PROPERTY_DEF),
551 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
552 AREF (item_properties, ITEM_PROPERTY_TYPE),
553 AREF (item_properties, ITEM_PROPERTY_SELECTED),
554 AREF (item_properties, ITEM_PROPERTY_HELP));
555
556 /* Display a submenu using the toolkit. */
557 if (! (NILP (map) || NILP (enabled)))
558 {
559 push_submenu_start ();
560 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
561 push_submenu_end ();
562 }
563 }
564 \f
565 /* Push all the panes and items of a menu described by the
566 alist-of-alists MENU.
567 This handles old-fashioned calls to x-popup-menu. */
568
569 static void
570 list_of_panes (menu)
571 Lisp_Object menu;
572 {
573 Lisp_Object tail;
574
575 init_menu_items ();
576
577 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
578 {
579 Lisp_Object elt, pane_name, pane_data;
580 elt = Fcar (tail);
581 pane_name = Fcar (elt);
582 CHECK_STRING (pane_name);
583 push_menu_pane (pane_name, Qnil);
584 pane_data = Fcdr (elt);
585 CHECK_CONS (pane_data);
586 list_of_items (pane_data);
587 }
588
589 finish_menu_items ();
590 }
591
592 /* Push the items in a single pane defined by the alist PANE. */
593
594 static void
595 list_of_items (pane)
596 Lisp_Object pane;
597 {
598 Lisp_Object tail, item, item1;
599
600 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
601 {
602 item = Fcar (tail);
603 if (STRINGP (item))
604 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
605 else if (NILP (item))
606 push_left_right_boundary ();
607 else
608 {
609 CHECK_CONS (item);
610 item1 = Fcar (item);
611 CHECK_STRING (item1);
612 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
613 }
614 }
615 }
616 \f
617 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
618 doc: /* Pop up a deck-of-cards menu and return user's selection.
619 POSITION is a position specification. This is either a mouse button
620 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
621 are positions in pixels from the top left corner of WINDOW's frame
622 \(WINDOW may be a frame object instead of a window). This controls the
623 position of the center of the first line in the first pane of the
624 menu, not the top left of the menu as a whole. If POSITION is t, it
625 means to use the current mouse position.
626
627 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
628 The menu items come from key bindings that have a menu string as well as
629 a definition; actually, the \"definition\" in such a key binding looks like
630 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
631 the keymap as a top-level element.
632
633 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
634 Otherwise, REAL-DEFINITION should be a valid key binding definition.
635
636 You can also use a list of keymaps as MENU. Then each keymap makes a
637 separate pane. When MENU is a keymap or a list of keymaps, the return
638 value is a list of events.
639
640 Alternatively, you can specify a menu of multiple panes with a list of
641 the form (TITLE PANE1 PANE2...), where each pane is a list of
642 form (TITLE ITEM1 ITEM2...).
643 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
644 appear as an item--that makes a nonselectable line in the menu.
645 With this form of menu, the return value is VALUE from the chosen item.
646
647 If POSITION is nil, don't display the menu at all, just precalculate the
648 cached information about equivalent key sequences. */)
649 (position, menu)
650 Lisp_Object position, menu;
651 {
652 Lisp_Object keymap, tem;
653 int xpos = 0, ypos = 0;
654 Lisp_Object title;
655 char *error_name;
656 Lisp_Object selection;
657 FRAME_PTR f = NULL;
658 Lisp_Object x, y, window;
659 int keymaps = 0;
660 int for_click = 0;
661 struct gcpro gcpro1;
662
663 #ifdef HAVE_MENUS
664 if (! NILP (position))
665 {
666 check_w32 ();
667
668 /* Decode the first argument: find the window and the coordinates. */
669 if (EQ (position, Qt)
670 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
671 || EQ (XCAR (position), Qtool_bar))))
672 {
673 /* Use the mouse's current position. */
674 FRAME_PTR new_f = SELECTED_FRAME ();
675 Lisp_Object bar_window;
676 enum scroll_bar_part part;
677 unsigned long time;
678
679 if (mouse_position_hook)
680 (*mouse_position_hook) (&new_f, 1, &bar_window,
681 &part, &x, &y, &time);
682 if (new_f != 0)
683 XSETFRAME (window, new_f);
684 else
685 {
686 window = selected_window;
687 XSETFASTINT (x, 0);
688 XSETFASTINT (y, 0);
689 }
690 }
691 else
692 {
693 tem = Fcar (position);
694 if (CONSP (tem))
695 {
696 window = Fcar (Fcdr (position));
697 x = Fcar (tem);
698 y = Fcar (Fcdr (tem));
699 }
700 else
701 {
702 for_click = 1;
703 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
704 window = Fcar (tem); /* POSN_WINDOW (tem) */
705 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
706 x = Fcar (tem);
707 y = Fcdr (tem);
708 }
709 }
710
711 CHECK_NUMBER (x);
712 CHECK_NUMBER (y);
713
714 /* Decode where to put the menu. */
715
716 if (FRAMEP (window))
717 {
718 f = XFRAME (window);
719 xpos = 0;
720 ypos = 0;
721 }
722 else if (WINDOWP (window))
723 {
724 CHECK_LIVE_WINDOW (window);
725 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
726
727 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
728 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
729 }
730 else
731 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
732 but I don't want to make one now. */
733 CHECK_WINDOW (window);
734
735 xpos += XINT (x);
736 ypos += XINT (y);
737
738 XSETFRAME (Vmenu_updating_frame, f);
739 }
740 Vmenu_updating_frame = Qnil;
741 #endif /* HAVE_MENUS */
742
743 title = Qnil;
744 GCPRO1 (title);
745
746 /* Decode the menu items from what was specified. */
747
748 keymap = get_keymap (menu, 0, 0);
749 if (CONSP (keymap))
750 {
751 /* We were given a keymap. Extract menu info from the keymap. */
752 Lisp_Object prompt;
753
754 /* Extract the detailed info to make one pane. */
755 keymap_panes (&menu, 1, NILP (position));
756
757 /* Search for a string appearing directly as an element of the keymap.
758 That string is the title of the menu. */
759 prompt = Fkeymap_prompt (keymap);
760 if (NILP (title) && !NILP (prompt))
761 title = prompt;
762
763 /* Make that be the pane title of the first pane. */
764 if (!NILP (prompt) && menu_items_n_panes >= 0)
765 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
766
767 keymaps = 1;
768 }
769 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
770 {
771 /* We were given a list of keymaps. */
772 int nmaps = XFASTINT (Flength (menu));
773 Lisp_Object *maps
774 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
775 int i;
776
777 title = Qnil;
778
779 /* The first keymap that has a prompt string
780 supplies the menu title. */
781 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
782 {
783 Lisp_Object prompt;
784
785 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
786
787 prompt = Fkeymap_prompt (keymap);
788 if (NILP (title) && !NILP (prompt))
789 title = prompt;
790 }
791
792 /* Extract the detailed info to make one pane. */
793 keymap_panes (maps, nmaps, NILP (position));
794
795 /* Make the title be the pane title of the first pane. */
796 if (!NILP (title) && menu_items_n_panes >= 0)
797 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
798
799 keymaps = 1;
800 }
801 else
802 {
803 /* We were given an old-fashioned menu. */
804 title = Fcar (menu);
805 CHECK_STRING (title);
806
807 list_of_panes (Fcdr (menu));
808
809 keymaps = 0;
810 }
811
812 if (NILP (position))
813 {
814 discard_menu_items ();
815 UNGCPRO;
816 return Qnil;
817 }
818
819 #ifdef HAVE_MENUS
820 /* If resources from a previous popup menu exist yet, does nothing
821 until the `menu_free_timer' has freed them (see w32fns.c).
822 */
823 if (current_popup_menu)
824 {
825 discard_menu_items ();
826 UNGCPRO;
827 return Qnil;
828 }
829
830 /* Display them in a menu. */
831 BLOCK_INPUT;
832
833 selection = w32_menu_show (f, xpos, ypos, for_click,
834 keymaps, title, &error_name);
835 UNBLOCK_INPUT;
836
837 discard_menu_items ();
838 #endif /* HAVE_MENUS */
839
840 UNGCPRO;
841
842 if (error_name) error (error_name);
843 return selection;
844 }
845
846 #ifdef HAVE_MENUS
847
848 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
849 doc: /* Pop up a dialog box and return user's selection.
850 POSITION specifies which frame to use.
851 This is normally a mouse button event or a window or frame.
852 If POSITION is t, it means to use the frame the mouse is on.
853 The dialog box appears in the middle of the specified frame.
854
855 CONTENTS specifies the alternatives to display in the dialog box.
856 It is a list of the form (TITLE ITEM1 ITEM2...).
857 Each ITEM is a cons cell (STRING . VALUE).
858 The return value is VALUE from the chosen item.
859
860 An ITEM may also be just a string--that makes a nonselectable item.
861 An ITEM may also be nil--that means to put all preceding items
862 on the left of the dialog box and all following items on the right.
863 \(By default, approximately half appear on each side.)
864
865 If HEADER is non-nil, the frame title for the box is "Information",
866 otherwise it is "Question". */)
867 (position, contents, header)
868 Lisp_Object position, contents, header;
869 {
870 FRAME_PTR f = NULL;
871 Lisp_Object window;
872
873 check_w32 ();
874
875 /* Decode the first argument: find the window or frame to use. */
876 if (EQ (position, Qt)
877 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
878 || EQ (XCAR (position), Qtool_bar))))
879 {
880 #if 0 /* Using the frame the mouse is on may not be right. */
881 /* Use the mouse's current position. */
882 FRAME_PTR new_f = SELECTED_FRAME ();
883 Lisp_Object bar_window;
884 enum scroll_bar_part part;
885 unsigned long time;
886 Lisp_Object x, y;
887
888 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
889
890 if (new_f != 0)
891 XSETFRAME (window, new_f);
892 else
893 window = selected_window;
894 #endif
895 window = selected_window;
896 }
897 else if (CONSP (position))
898 {
899 Lisp_Object tem;
900 tem = Fcar (position);
901 if (CONSP (tem))
902 window = Fcar (Fcdr (position));
903 else
904 {
905 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
906 window = Fcar (tem); /* POSN_WINDOW (tem) */
907 }
908 }
909 else if (WINDOWP (position) || FRAMEP (position))
910 window = position;
911 else
912 window = Qnil;
913
914 /* Decode where to put the menu. */
915
916 if (FRAMEP (window))
917 f = XFRAME (window);
918 else if (WINDOWP (window))
919 {
920 CHECK_LIVE_WINDOW (window);
921 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
922 }
923 else
924 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
925 but I don't want to make one now. */
926 CHECK_WINDOW (window);
927
928 #ifndef HAVE_DIALOGS
929 /* Display a menu with these alternatives
930 in the middle of frame F. */
931 {
932 Lisp_Object x, y, frame, newpos;
933 XSETFRAME (frame, f);
934 XSETINT (x, x_pixel_width (f) / 2);
935 XSETINT (y, x_pixel_height (f) / 2);
936 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
937
938 return Fx_popup_menu (newpos,
939 Fcons (Fcar (contents), Fcons (contents, Qnil)));
940 }
941 #else /* HAVE_DIALOGS */
942 {
943 Lisp_Object title;
944 char *error_name;
945 Lisp_Object selection;
946
947 /* Decode the dialog items from what was specified. */
948 title = Fcar (contents);
949 CHECK_STRING (title);
950
951 list_of_panes (Fcons (contents, Qnil));
952
953 /* Display them in a dialog box. */
954 BLOCK_INPUT;
955 selection = w32_dialog_show (f, 0, title, header, &error_name);
956 UNBLOCK_INPUT;
957
958 discard_menu_items ();
959
960 if (error_name) error (error_name);
961 return selection;
962 }
963 #endif /* HAVE_DIALOGS */
964 }
965
966 /* Activate the menu bar of frame F.
967 This is called from keyboard.c when it gets the
968 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
969
970 To activate the menu bar, we signal to the input thread that it can
971 return from the WM_INITMENU message, allowing the normal Windows
972 processing of the menus.
973
974 But first we recompute the menu bar contents (the whole tree).
975
976 This way we can safely execute Lisp code. */
977
978 void
979 x_activate_menubar (f)
980 FRAME_PTR f;
981 {
982 set_frame_menubar (f, 0, 1);
983
984 /* Lock out further menubar changes while active. */
985 f->output_data.w32->menubar_active = 1;
986
987 /* Signal input thread to return from WM_INITMENU. */
988 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
989 }
990
991 /* This callback is called from the menu bar pulldown menu
992 when the user makes a selection.
993 Figure out what the user chose
994 and put the appropriate events into the keyboard buffer. */
995
996 void
997 menubar_selection_callback (FRAME_PTR f, void * client_data)
998 {
999 Lisp_Object prefix, entry;
1000 Lisp_Object vector;
1001 Lisp_Object *subprefix_stack;
1002 int submenu_depth = 0;
1003 int i;
1004
1005 if (!f)
1006 return;
1007 entry = Qnil;
1008 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1009 vector = f->menu_bar_vector;
1010 prefix = Qnil;
1011 i = 0;
1012 while (i < f->menu_bar_items_used)
1013 {
1014 if (EQ (AREF (vector, i), Qnil))
1015 {
1016 subprefix_stack[submenu_depth++] = prefix;
1017 prefix = entry;
1018 i++;
1019 }
1020 else if (EQ (AREF (vector, i), Qlambda))
1021 {
1022 prefix = subprefix_stack[--submenu_depth];
1023 i++;
1024 }
1025 else if (EQ (AREF (vector, i), Qt))
1026 {
1027 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1028 i += MENU_ITEMS_PANE_LENGTH;
1029 }
1030 else
1031 {
1032 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1033 /* The EMACS_INT cast avoids a warning. There's no problem
1034 as long as pointers have enough bits to hold small integers. */
1035 if ((int) (EMACS_INT) client_data == i)
1036 {
1037 int j;
1038 struct input_event buf;
1039 Lisp_Object frame;
1040 EVENT_INIT (buf);
1041
1042 XSETFRAME (frame, f);
1043 buf.kind = MENU_BAR_EVENT;
1044 buf.frame_or_window = frame;
1045 buf.arg = frame;
1046 kbd_buffer_store_event (&buf);
1047
1048 for (j = 0; j < submenu_depth; j++)
1049 if (!NILP (subprefix_stack[j]))
1050 {
1051 buf.kind = MENU_BAR_EVENT;
1052 buf.frame_or_window = frame;
1053 buf.arg = subprefix_stack[j];
1054 kbd_buffer_store_event (&buf);
1055 }
1056
1057 if (!NILP (prefix))
1058 {
1059 buf.kind = MENU_BAR_EVENT;
1060 buf.frame_or_window = frame;
1061 buf.arg = prefix;
1062 kbd_buffer_store_event (&buf);
1063 }
1064
1065 buf.kind = MENU_BAR_EVENT;
1066 buf.frame_or_window = frame;
1067 buf.arg = entry;
1068 kbd_buffer_store_event (&buf);
1069
1070 /* Free memory used by owner-drawn and help-echo strings. */
1071 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1072 f->output_data.w32->menu_command_in_progress = 0;
1073 f->output_data.w32->menubar_active = 0;
1074 return;
1075 }
1076 i += MENU_ITEMS_ITEM_LENGTH;
1077 }
1078 }
1079 /* Free memory used by owner-drawn and help-echo strings. */
1080 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1081 f->output_data.w32->menu_command_in_progress = 0;
1082 f->output_data.w32->menubar_active = 0;
1083 }
1084
1085 /* Allocate a widget_value, blocking input. */
1086
1087 widget_value *
1088 xmalloc_widget_value ()
1089 {
1090 widget_value *value;
1091
1092 BLOCK_INPUT;
1093 value = malloc_widget_value ();
1094 UNBLOCK_INPUT;
1095
1096 return value;
1097 }
1098
1099 /* This recursively calls free_widget_value on the tree of widgets.
1100 It must free all data that was malloc'ed for these widget_values.
1101 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1102 must be left alone. */
1103
1104 void
1105 free_menubar_widget_value_tree (wv)
1106 widget_value *wv;
1107 {
1108 if (! wv) return;
1109
1110 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1111
1112 if (wv->contents && (wv->contents != (widget_value*)1))
1113 {
1114 free_menubar_widget_value_tree (wv->contents);
1115 wv->contents = (widget_value *) 0xDEADBEEF;
1116 }
1117 if (wv->next)
1118 {
1119 free_menubar_widget_value_tree (wv->next);
1120 wv->next = (widget_value *) 0xDEADBEEF;
1121 }
1122 BLOCK_INPUT;
1123 free_widget_value (wv);
1124 UNBLOCK_INPUT;
1125 }
1126 \f
1127 /* Set up data i menu_items for a menu bar item
1128 whose event type is ITEM_KEY (with string ITEM_NAME)
1129 and whose contents come from the list of keymaps MAPS. */
1130
1131 static int
1132 parse_single_submenu (item_key, item_name, maps)
1133 Lisp_Object item_key, item_name, maps;
1134 {
1135 Lisp_Object length;
1136 int len;
1137 Lisp_Object *mapvec;
1138 int i;
1139 int top_level_items = 0;
1140
1141 length = Flength (maps);
1142 len = XINT (length);
1143
1144 /* Convert the list MAPS into a vector MAPVEC. */
1145 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1146 for (i = 0; i < len; i++)
1147 {
1148 mapvec[i] = Fcar (maps);
1149 maps = Fcdr (maps);
1150 }
1151
1152 /* Loop over the given keymaps, making a pane for each map.
1153 But don't make a pane that is empty--ignore that map instead. */
1154 for (i = 0; i < len; i++)
1155 {
1156 if (SYMBOLP (mapvec[i])
1157 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1158 {
1159 /* Here we have a command at top level in the menu bar
1160 as opposed to a submenu. */
1161 top_level_items = 1;
1162 push_menu_pane (Qnil, Qnil);
1163 push_menu_item (item_name, Qt, item_key, mapvec[i],
1164 Qnil, Qnil, Qnil, Qnil);
1165 }
1166 else
1167 {
1168 Lisp_Object prompt;
1169 prompt = Fkeymap_prompt (mapvec[i]);
1170 single_keymap_panes (mapvec[i],
1171 !NILP (prompt) ? prompt : item_name,
1172 item_key, 0, 10);
1173 }
1174 }
1175
1176 return top_level_items;
1177 }
1178
1179
1180 /* Create a tree of widget_value objects
1181 representing the panes and items
1182 in menu_items starting at index START, up to index END. */
1183
1184 static widget_value *
1185 digest_single_submenu (start, end, top_level_items)
1186 int start, end, top_level_items;
1187 {
1188 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1189 int i;
1190 int submenu_depth = 0;
1191 widget_value **submenu_stack;
1192
1193 submenu_stack
1194 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1195 wv = xmalloc_widget_value ();
1196 wv->name = "menu";
1197 wv->value = 0;
1198 wv->enabled = 1;
1199 wv->button_type = BUTTON_TYPE_NONE;
1200 wv->help = Qnil;
1201 first_wv = wv;
1202 save_wv = 0;
1203 prev_wv = 0;
1204
1205 /* Loop over all panes and items made by the preceding call
1206 to parse_single_submenu and construct a tree of widget_value objects.
1207 Ignore the panes and items used by previous calls to
1208 digest_single_submenu, even though those are also in menu_items. */
1209 i = start;
1210 while (i < end)
1211 {
1212 if (EQ (AREF (menu_items, i), Qnil))
1213 {
1214 submenu_stack[submenu_depth++] = save_wv;
1215 save_wv = prev_wv;
1216 prev_wv = 0;
1217 i++;
1218 }
1219 else if (EQ (AREF (menu_items, i), Qlambda))
1220 {
1221 prev_wv = save_wv;
1222 save_wv = submenu_stack[--submenu_depth];
1223 i++;
1224 }
1225 else if (EQ (AREF (menu_items, i), Qt)
1226 && submenu_depth != 0)
1227 i += MENU_ITEMS_PANE_LENGTH;
1228 /* Ignore a nil in the item list.
1229 It's meaningful only for dialog boxes. */
1230 else if (EQ (AREF (menu_items, i), Qquote))
1231 i += 1;
1232 else if (EQ (AREF (menu_items, i), Qt))
1233 {
1234 /* Create a new pane. */
1235 Lisp_Object pane_name, prefix;
1236 char *pane_string;
1237
1238 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1239 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1240
1241 if (STRINGP (pane_name))
1242 {
1243 if (unicode_append_menu)
1244 /* Encode as UTF-8 for now. */
1245 pane_name = ENCODE_UTF_8 (pane_name);
1246 else if (STRING_MULTIBYTE (pane_name))
1247 pane_name = ENCODE_SYSTEM (pane_name);
1248
1249 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1250 }
1251
1252 pane_string = (NILP (pane_name)
1253 ? "" : (char *) SDATA (pane_name));
1254 /* If there is just one top-level pane, put all its items directly
1255 under the top-level menu. */
1256 if (menu_items_n_panes == 1)
1257 pane_string = "";
1258
1259 /* If the pane has a meaningful name,
1260 make the pane a top-level menu item
1261 with its items as a submenu beneath it. */
1262 if (strcmp (pane_string, ""))
1263 {
1264 wv = xmalloc_widget_value ();
1265 if (save_wv)
1266 save_wv->next = wv;
1267 else
1268 first_wv->contents = wv;
1269 wv->lname = pane_name;
1270 /* Set value to 1 so update_submenu_strings can handle '@' */
1271 wv->value = (char *) 1;
1272 wv->enabled = 1;
1273 wv->button_type = BUTTON_TYPE_NONE;
1274 wv->help = Qnil;
1275 }
1276 save_wv = wv;
1277 prev_wv = 0;
1278 i += MENU_ITEMS_PANE_LENGTH;
1279 }
1280 else
1281 {
1282 /* Create a new item within current pane. */
1283 Lisp_Object item_name, enable, descrip, def, type, selected;
1284 Lisp_Object help;
1285
1286 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1287 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1288 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1289 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1290 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1291 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1292 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1293
1294 if (STRINGP (item_name))
1295 {
1296 if (unicode_append_menu)
1297 item_name = ENCODE_UTF_8 (item_name);
1298 else if (STRING_MULTIBYTE (item_name))
1299 item_name = ENCODE_SYSTEM (item_name);
1300
1301 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1302 }
1303
1304 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1305 {
1306 descrip = ENCODE_SYSTEM (descrip);
1307 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1308 }
1309
1310 wv = xmalloc_widget_value ();
1311 if (prev_wv)
1312 prev_wv->next = wv;
1313 else
1314 save_wv->contents = wv;
1315
1316 wv->lname = item_name;
1317 if (!NILP (descrip))
1318 wv->lkey = descrip;
1319 wv->value = 0;
1320 /* The EMACS_INT cast avoids a warning. There's no problem
1321 as long as pointers have enough bits to hold small integers. */
1322 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1323 wv->enabled = !NILP (enable);
1324
1325 if (NILP (type))
1326 wv->button_type = BUTTON_TYPE_NONE;
1327 else if (EQ (type, QCradio))
1328 wv->button_type = BUTTON_TYPE_RADIO;
1329 else if (EQ (type, QCtoggle))
1330 wv->button_type = BUTTON_TYPE_TOGGLE;
1331 else
1332 abort ();
1333
1334 wv->selected = !NILP (selected);
1335 if (!STRINGP (help))
1336 help = Qnil;
1337
1338 wv->help = help;
1339
1340 prev_wv = wv;
1341
1342 i += MENU_ITEMS_ITEM_LENGTH;
1343 }
1344 }
1345
1346 /* If we have just one "menu item"
1347 that was originally a button, return it by itself. */
1348 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1349 {
1350 wv = first_wv->contents;
1351 free_widget_value (first_wv);
1352 return wv;
1353 }
1354
1355 return first_wv;
1356 }
1357
1358
1359 /* Walk through the widget_value tree starting at FIRST_WV and update
1360 the char * pointers from the corresponding lisp values.
1361 We do this after building the whole tree, since GC may happen while the
1362 tree is constructed, and small strings are relocated. So we must wait
1363 until no GC can happen before storing pointers into lisp values. */
1364 static void
1365 update_submenu_strings (first_wv)
1366 widget_value *first_wv;
1367 {
1368 widget_value *wv;
1369
1370 for (wv = first_wv; wv; wv = wv->next)
1371 {
1372 if (wv->lname && ! NILP (wv->lname))
1373 {
1374 wv->name = SDATA (wv->lname);
1375
1376 /* Ignore the @ that means "separate pane".
1377 This is a kludge, but this isn't worth more time. */
1378 if (wv->value == (char *)1)
1379 {
1380 if (wv->name[0] == '@')
1381 wv->name++;
1382 wv->value = 0;
1383 }
1384 }
1385
1386 if (wv->lkey && ! NILP (wv->lkey))
1387 wv->key = SDATA (wv->lkey);
1388
1389 if (wv->contents)
1390 update_submenu_strings (wv->contents);
1391 }
1392 }
1393
1394 \f
1395 /* Set the contents of the menubar widgets of frame F.
1396 The argument FIRST_TIME is currently ignored;
1397 it is set the first time this is called, from initialize_frame_menubar. */
1398
1399 void
1400 set_frame_menubar (f, first_time, deep_p)
1401 FRAME_PTR f;
1402 int first_time;
1403 int deep_p;
1404 {
1405 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1406 Lisp_Object items;
1407 widget_value *wv, *first_wv, *prev_wv = 0;
1408 int i, last_i;
1409 int *submenu_start, *submenu_end;
1410 int *submenu_top_level_items, *submenu_n_panes;
1411
1412 /* We must not change the menubar when actually in use. */
1413 if (f->output_data.w32->menubar_active)
1414 return;
1415
1416 XSETFRAME (Vmenu_updating_frame, f);
1417
1418 if (! menubar_widget)
1419 deep_p = 1;
1420 else if (pending_menu_activation && !deep_p)
1421 deep_p = 1;
1422
1423 if (deep_p)
1424 {
1425 /* Make a widget-value tree representing the entire menu trees. */
1426
1427 struct buffer *prev = current_buffer;
1428 Lisp_Object buffer;
1429 int specpdl_count = SPECPDL_INDEX ();
1430 int previous_menu_items_used = f->menu_bar_items_used;
1431 Lisp_Object *previous_items
1432 = (Lisp_Object *) alloca (previous_menu_items_used
1433 * sizeof (Lisp_Object));
1434
1435 /* If we are making a new widget, its contents are empty,
1436 do always reinitialize them. */
1437 if (! menubar_widget)
1438 previous_menu_items_used = 0;
1439
1440 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1441 specbind (Qinhibit_quit, Qt);
1442 /* Don't let the debugger step into this code
1443 because it is not reentrant. */
1444 specbind (Qdebug_on_next_call, Qnil);
1445
1446 record_unwind_save_match_data ();
1447
1448 if (NILP (Voverriding_local_map_menu_flag))
1449 {
1450 specbind (Qoverriding_terminal_local_map, Qnil);
1451 specbind (Qoverriding_local_map, Qnil);
1452 }
1453
1454 set_buffer_internal_1 (XBUFFER (buffer));
1455
1456 /* Run the Lucid hook. */
1457 safe_run_hooks (Qactivate_menubar_hook);
1458 /* If it has changed current-menubar from previous value,
1459 really recompute the menubar from the value. */
1460 if (! NILP (Vlucid_menu_bar_dirty_flag))
1461 call0 (Qrecompute_lucid_menubar);
1462 safe_run_hooks (Qmenu_bar_update_hook);
1463 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1464
1465 items = FRAME_MENU_BAR_ITEMS (f);
1466
1467 /* Save the frame's previous menu bar contents data. */
1468 if (previous_menu_items_used)
1469 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1470 previous_menu_items_used * sizeof (Lisp_Object));
1471
1472 /* Fill in menu_items with the current menu bar contents.
1473 This can evaluate Lisp code. */
1474 menu_items = f->menu_bar_vector;
1475 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1476 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1477 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1478 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1479 submenu_top_level_items
1480 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1481 init_menu_items ();
1482 for (i = 0; i < ASIZE (items); i += 4)
1483 {
1484 Lisp_Object key, string, maps;
1485
1486 last_i = i;
1487
1488 key = AREF (items, i);
1489 string = AREF (items, i + 1);
1490 maps = AREF (items, i + 2);
1491 if (NILP (string))
1492 break;
1493
1494 submenu_start[i] = menu_items_used;
1495
1496 menu_items_n_panes = 0;
1497 submenu_top_level_items[i]
1498 = parse_single_submenu (key, string, maps);
1499 submenu_n_panes[i] = menu_items_n_panes;
1500
1501 submenu_end[i] = menu_items_used;
1502 }
1503
1504 finish_menu_items ();
1505
1506 /* Convert menu_items into widget_value trees
1507 to display the menu. This cannot evaluate Lisp code. */
1508
1509 wv = xmalloc_widget_value ();
1510 wv->name = "menubar";
1511 wv->value = 0;
1512 wv->enabled = 1;
1513 wv->button_type = BUTTON_TYPE_NONE;
1514 wv->help = Qnil;
1515 first_wv = wv;
1516
1517 for (i = 0; i < last_i; i += 4)
1518 {
1519 menu_items_n_panes = submenu_n_panes[i];
1520 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1521 submenu_top_level_items[i]);
1522 if (prev_wv)
1523 prev_wv->next = wv;
1524 else
1525 first_wv->contents = wv;
1526 /* Don't set wv->name here; GC during the loop might relocate it. */
1527 wv->enabled = 1;
1528 wv->button_type = BUTTON_TYPE_NONE;
1529 prev_wv = wv;
1530 }
1531
1532 set_buffer_internal_1 (prev);
1533 unbind_to (specpdl_count, Qnil);
1534
1535 /* If there has been no change in the Lisp-level contents
1536 of the menu bar, skip redisplaying it. Just exit. */
1537
1538 for (i = 0; i < previous_menu_items_used; i++)
1539 if (menu_items_used == i
1540 || (!EQ (previous_items[i], AREF (menu_items, i))))
1541 break;
1542 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1543 {
1544 free_menubar_widget_value_tree (first_wv);
1545 menu_items = Qnil;
1546
1547 return;
1548 }
1549
1550 /* Now GC cannot happen during the lifetime of the widget_value,
1551 so it's safe to store data from a Lisp_String, as long as
1552 local copies are made when the actual menu is created.
1553 Windows takes care of this for normal string items, but
1554 not for owner-drawn items or additional item-info. */
1555 wv = first_wv->contents;
1556 for (i = 0; i < ASIZE (items); i += 4)
1557 {
1558 Lisp_Object string;
1559 string = AREF (items, i + 1);
1560 if (NILP (string))
1561 break;
1562 wv->name = (char *) SDATA (string);
1563 update_submenu_strings (wv->contents);
1564 wv = wv->next;
1565 }
1566
1567 f->menu_bar_vector = menu_items;
1568 f->menu_bar_items_used = menu_items_used;
1569 menu_items = Qnil;
1570 }
1571 else
1572 {
1573 /* Make a widget-value tree containing
1574 just the top level menu bar strings. */
1575
1576 wv = xmalloc_widget_value ();
1577 wv->name = "menubar";
1578 wv->value = 0;
1579 wv->enabled = 1;
1580 wv->button_type = BUTTON_TYPE_NONE;
1581 wv->help = Qnil;
1582 first_wv = wv;
1583
1584 items = FRAME_MENU_BAR_ITEMS (f);
1585 for (i = 0; i < ASIZE (items); i += 4)
1586 {
1587 Lisp_Object string;
1588
1589 string = AREF (items, i + 1);
1590 if (NILP (string))
1591 break;
1592
1593 wv = xmalloc_widget_value ();
1594 wv->name = (char *) SDATA (string);
1595 wv->value = 0;
1596 wv->enabled = 1;
1597 wv->button_type = BUTTON_TYPE_NONE;
1598 wv->help = Qnil;
1599 /* This prevents lwlib from assuming this
1600 menu item is really supposed to be empty. */
1601 /* The EMACS_INT cast avoids a warning.
1602 This value just has to be different from small integers. */
1603 wv->call_data = (void *) (EMACS_INT) (-1);
1604
1605 if (prev_wv)
1606 prev_wv->next = wv;
1607 else
1608 first_wv->contents = wv;
1609 prev_wv = wv;
1610 }
1611
1612 /* Forget what we thought we knew about what is in the
1613 detailed contents of the menu bar menus.
1614 Changing the top level always destroys the contents. */
1615 f->menu_bar_items_used = 0;
1616 }
1617
1618 /* Create or update the menu bar widget. */
1619
1620 BLOCK_INPUT;
1621
1622 if (menubar_widget)
1623 {
1624 /* Empty current menubar, rather than creating a fresh one. */
1625 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1626 ;
1627 }
1628 else
1629 {
1630 menubar_widget = CreateMenu ();
1631 }
1632 fill_in_menu (menubar_widget, first_wv->contents);
1633
1634 free_menubar_widget_value_tree (first_wv);
1635
1636 {
1637 HMENU old_widget = f->output_data.w32->menubar_widget;
1638
1639 f->output_data.w32->menubar_widget = menubar_widget;
1640 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1641 /* Causes flicker when menu bar is updated
1642 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1643
1644 /* Force the window size to be recomputed so that the frame's text
1645 area remains the same, if menubar has just been created. */
1646 if (old_widget == NULL)
1647 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1648 }
1649
1650 UNBLOCK_INPUT;
1651 }
1652
1653 /* Called from Fx_create_frame to create the initial menubar of a frame
1654 before it is mapped, so that the window is mapped with the menubar already
1655 there instead of us tacking it on later and thrashing the window after it
1656 is visible. */
1657
1658 void
1659 initialize_frame_menubar (f)
1660 FRAME_PTR f;
1661 {
1662 /* This function is called before the first chance to redisplay
1663 the frame. It has to be, so the frame will have the right size. */
1664 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1665 set_frame_menubar (f, 1, 1);
1666 }
1667
1668 /* Get rid of the menu bar of frame F, and free its storage.
1669 This is used when deleting a frame, and when turning off the menu bar. */
1670
1671 void
1672 free_frame_menubar (f)
1673 FRAME_PTR f;
1674 {
1675 BLOCK_INPUT;
1676
1677 {
1678 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1679 SetMenu (FRAME_W32_WINDOW (f), NULL);
1680 f->output_data.w32->menubar_widget = NULL;
1681 DestroyMenu (old);
1682 }
1683
1684 UNBLOCK_INPUT;
1685 }
1686
1687 \f
1688 /* w32_menu_show actually displays a menu using the panes and items in
1689 menu_items and returns the value selected from it; we assume input
1690 is blocked by the caller. */
1691
1692 /* F is the frame the menu is for.
1693 X and Y are the frame-relative specified position,
1694 relative to the inside upper left corner of the frame F.
1695 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1696 KEYMAPS is 1 if this menu was specified with keymaps;
1697 in that case, we return a list containing the chosen item's value
1698 and perhaps also the pane's prefix.
1699 TITLE is the specified menu title.
1700 ERROR is a place to store an error message string in case of failure.
1701 (We return nil on failure, but the value doesn't actually matter.) */
1702
1703 static Lisp_Object
1704 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1705 FRAME_PTR f;
1706 int x;
1707 int y;
1708 int for_click;
1709 int keymaps;
1710 Lisp_Object title;
1711 char **error;
1712 {
1713 int i;
1714 int menu_item_selection;
1715 HMENU menu;
1716 POINT pos;
1717 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1718 widget_value **submenu_stack
1719 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1720 Lisp_Object *subprefix_stack
1721 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1722 int submenu_depth = 0;
1723 int first_pane;
1724
1725 *error = NULL;
1726
1727 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1728 {
1729 *error = "Empty menu";
1730 return Qnil;
1731 }
1732
1733 /* Create a tree of widget_value objects
1734 representing the panes and their items. */
1735 wv = xmalloc_widget_value ();
1736 wv->name = "menu";
1737 wv->value = 0;
1738 wv->enabled = 1;
1739 wv->button_type = BUTTON_TYPE_NONE;
1740 wv->help = Qnil;
1741 first_wv = wv;
1742 first_pane = 1;
1743
1744 /* Loop over all panes and items, filling in the tree. */
1745 i = 0;
1746 while (i < menu_items_used)
1747 {
1748 if (EQ (AREF (menu_items, i), Qnil))
1749 {
1750 submenu_stack[submenu_depth++] = save_wv;
1751 save_wv = prev_wv;
1752 prev_wv = 0;
1753 first_pane = 1;
1754 i++;
1755 }
1756 else if (EQ (AREF (menu_items, i), Qlambda))
1757 {
1758 prev_wv = save_wv;
1759 save_wv = submenu_stack[--submenu_depth];
1760 first_pane = 0;
1761 i++;
1762 }
1763 else if (EQ (AREF (menu_items, i), Qt)
1764 && submenu_depth != 0)
1765 i += MENU_ITEMS_PANE_LENGTH;
1766 /* Ignore a nil in the item list.
1767 It's meaningful only for dialog boxes. */
1768 else if (EQ (AREF (menu_items, i), Qquote))
1769 i += 1;
1770 else if (EQ (AREF (menu_items, i), Qt))
1771 {
1772 /* Create a new pane. */
1773 Lisp_Object pane_name, prefix;
1774 char *pane_string;
1775 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1776 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1777
1778 if (STRINGP (pane_name))
1779 {
1780 if (unicode_append_menu)
1781 pane_name = ENCODE_UTF_8 (pane_name);
1782 else if (STRING_MULTIBYTE (pane_name))
1783 pane_name = ENCODE_SYSTEM (pane_name);
1784
1785 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1786 }
1787
1788 pane_string = (NILP (pane_name)
1789 ? "" : (char *) SDATA (pane_name));
1790 /* If there is just one top-level pane, put all its items directly
1791 under the top-level menu. */
1792 if (menu_items_n_panes == 1)
1793 pane_string = "";
1794
1795 /* If the pane has a meaningful name,
1796 make the pane a top-level menu item
1797 with its items as a submenu beneath it. */
1798 if (!keymaps && strcmp (pane_string, ""))
1799 {
1800 wv = xmalloc_widget_value ();
1801 if (save_wv)
1802 save_wv->next = wv;
1803 else
1804 first_wv->contents = wv;
1805 wv->name = pane_string;
1806 if (keymaps && !NILP (prefix))
1807 wv->name++;
1808 wv->value = 0;
1809 wv->enabled = 1;
1810 wv->button_type = BUTTON_TYPE_NONE;
1811 wv->help = Qnil;
1812 save_wv = wv;
1813 prev_wv = 0;
1814 }
1815 else if (first_pane)
1816 {
1817 save_wv = wv;
1818 prev_wv = 0;
1819 }
1820 first_pane = 0;
1821 i += MENU_ITEMS_PANE_LENGTH;
1822 }
1823 else
1824 {
1825 /* Create a new item within current pane. */
1826 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1827
1828 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1829 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1830 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1831 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1832 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1833 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1834 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1835
1836 if (STRINGP (item_name))
1837 {
1838 if (unicode_append_menu)
1839 item_name = ENCODE_UTF_8 (item_name);
1840 else if (STRING_MULTIBYTE (item_name))
1841 item_name = ENCODE_SYSTEM (item_name);
1842
1843 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1844 }
1845
1846 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1847 {
1848 descrip = ENCODE_SYSTEM (descrip);
1849 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1850 }
1851
1852 wv = xmalloc_widget_value ();
1853 if (prev_wv)
1854 prev_wv->next = wv;
1855 else
1856 save_wv->contents = wv;
1857 wv->name = (char *) SDATA (item_name);
1858 if (!NILP (descrip))
1859 wv->key = (char *) SDATA (descrip);
1860 wv->value = 0;
1861 /* Use the contents index as call_data, since we are
1862 restricted to 16-bits. */
1863 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1864 wv->enabled = !NILP (enable);
1865
1866 if (NILP (type))
1867 wv->button_type = BUTTON_TYPE_NONE;
1868 else if (EQ (type, QCtoggle))
1869 wv->button_type = BUTTON_TYPE_TOGGLE;
1870 else if (EQ (type, QCradio))
1871 wv->button_type = BUTTON_TYPE_RADIO;
1872 else
1873 abort ();
1874
1875 wv->selected = !NILP (selected);
1876 if (!STRINGP (help))
1877 help = Qnil;
1878
1879 wv->help = help;
1880
1881 prev_wv = wv;
1882
1883 i += MENU_ITEMS_ITEM_LENGTH;
1884 }
1885 }
1886
1887 /* Deal with the title, if it is non-nil. */
1888 if (!NILP (title))
1889 {
1890 widget_value *wv_title = xmalloc_widget_value ();
1891 widget_value *wv_sep = xmalloc_widget_value ();
1892
1893 /* Maybe replace this separator with a bitmap or owner-draw item
1894 so that it looks better. Having two separators looks odd. */
1895 wv_sep->name = "--";
1896 wv_sep->next = first_wv->contents;
1897 wv_sep->help = Qnil;
1898
1899 if (unicode_append_menu)
1900 title = ENCODE_UTF_8 (title);
1901 else if (STRING_MULTIBYTE (title))
1902 title = ENCODE_SYSTEM (title);
1903
1904 wv_title->name = (char *) SDATA (title);
1905 wv_title->enabled = TRUE;
1906 wv_title->title = TRUE;
1907 wv_title->button_type = BUTTON_TYPE_NONE;
1908 wv_title->help = Qnil;
1909 wv_title->next = wv_sep;
1910 first_wv->contents = wv_title;
1911 }
1912
1913 /* Actually create the menu. */
1914 current_popup_menu = menu = CreatePopupMenu ();
1915 fill_in_menu (menu, first_wv->contents);
1916
1917 /* Adjust coordinates to be root-window-relative. */
1918 pos.x = x;
1919 pos.y = y;
1920 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1921
1922 /* No selection has been chosen yet. */
1923 menu_item_selection = 0;
1924
1925 /* Display the menu. */
1926 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1927 WM_EMACS_TRACKPOPUPMENU,
1928 (WPARAM)menu, (LPARAM)&pos);
1929
1930 /* Clean up extraneous mouse events which might have been generated
1931 during the call. */
1932 discard_mouse_events ();
1933
1934 /* Free the widget_value objects we used to specify the contents. */
1935 free_menubar_widget_value_tree (first_wv);
1936
1937 DestroyMenu (menu);
1938
1939 /* Find the selected item, and its pane, to return
1940 the proper value. */
1941 if (menu_item_selection != 0)
1942 {
1943 Lisp_Object prefix, entry;
1944
1945 prefix = entry = Qnil;
1946 i = 0;
1947 while (i < menu_items_used)
1948 {
1949 if (EQ (AREF (menu_items, i), Qnil))
1950 {
1951 subprefix_stack[submenu_depth++] = prefix;
1952 prefix = entry;
1953 i++;
1954 }
1955 else if (EQ (AREF (menu_items, i), Qlambda))
1956 {
1957 prefix = subprefix_stack[--submenu_depth];
1958 i++;
1959 }
1960 else if (EQ (AREF (menu_items, i), Qt))
1961 {
1962 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1963 i += MENU_ITEMS_PANE_LENGTH;
1964 }
1965 /* Ignore a nil in the item list.
1966 It's meaningful only for dialog boxes. */
1967 else if (EQ (AREF (menu_items, i), Qquote))
1968 i += 1;
1969 else
1970 {
1971 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1972 if (menu_item_selection == i)
1973 {
1974 if (keymaps != 0)
1975 {
1976 int j;
1977
1978 entry = Fcons (entry, Qnil);
1979 if (!NILP (prefix))
1980 entry = Fcons (prefix, entry);
1981 for (j = submenu_depth - 1; j >= 0; j--)
1982 if (!NILP (subprefix_stack[j]))
1983 entry = Fcons (subprefix_stack[j], entry);
1984 }
1985 return entry;
1986 }
1987 i += MENU_ITEMS_ITEM_LENGTH;
1988 }
1989 }
1990 }
1991
1992 return Qnil;
1993 }
1994 \f
1995
1996 #ifdef HAVE_DIALOGS
1997 static char * button_names [] = {
1998 "button1", "button2", "button3", "button4", "button5",
1999 "button6", "button7", "button8", "button9", "button10" };
2000
2001 static Lisp_Object
2002 w32_dialog_show (f, keymaps, title, header, error)
2003 FRAME_PTR f;
2004 int keymaps;
2005 Lisp_Object title, header;
2006 char **error;
2007 {
2008 int i, nb_buttons=0;
2009 char dialog_name[6];
2010 int menu_item_selection;
2011
2012 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2013
2014 /* Number of elements seen so far, before boundary. */
2015 int left_count = 0;
2016 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2017 int boundary_seen = 0;
2018
2019 *error = NULL;
2020
2021 if (menu_items_n_panes > 1)
2022 {
2023 *error = "Multiple panes in dialog box";
2024 return Qnil;
2025 }
2026
2027 /* Create a tree of widget_value objects
2028 representing the text label and buttons. */
2029 {
2030 Lisp_Object pane_name, prefix;
2031 char *pane_string;
2032 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2033 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2034 pane_string = (NILP (pane_name)
2035 ? "" : (char *) SDATA (pane_name));
2036 prev_wv = xmalloc_widget_value ();
2037 prev_wv->value = pane_string;
2038 if (keymaps && !NILP (prefix))
2039 prev_wv->name++;
2040 prev_wv->enabled = 1;
2041 prev_wv->name = "message";
2042 prev_wv->help = Qnil;
2043 first_wv = prev_wv;
2044
2045 /* Loop over all panes and items, filling in the tree. */
2046 i = MENU_ITEMS_PANE_LENGTH;
2047 while (i < menu_items_used)
2048 {
2049
2050 /* Create a new item within current pane. */
2051 Lisp_Object item_name, enable, descrip, help;
2052
2053 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2054 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2055 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2056 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2057
2058 if (NILP (item_name))
2059 {
2060 free_menubar_widget_value_tree (first_wv);
2061 *error = "Submenu in dialog items";
2062 return Qnil;
2063 }
2064 if (EQ (item_name, Qquote))
2065 {
2066 /* This is the boundary between left-side elts
2067 and right-side elts. Stop incrementing right_count. */
2068 boundary_seen = 1;
2069 i++;
2070 continue;
2071 }
2072 if (nb_buttons >= 9)
2073 {
2074 free_menubar_widget_value_tree (first_wv);
2075 *error = "Too many dialog items";
2076 return Qnil;
2077 }
2078
2079 wv = xmalloc_widget_value ();
2080 prev_wv->next = wv;
2081 wv->name = (char *) button_names[nb_buttons];
2082 if (!NILP (descrip))
2083 wv->key = (char *) SDATA (descrip);
2084 wv->value = (char *) SDATA (item_name);
2085 wv->call_data = (void *) &AREF (menu_items, i);
2086 wv->enabled = !NILP (enable);
2087 wv->help = Qnil;
2088 prev_wv = wv;
2089
2090 if (! boundary_seen)
2091 left_count++;
2092
2093 nb_buttons++;
2094 i += MENU_ITEMS_ITEM_LENGTH;
2095 }
2096
2097 /* If the boundary was not specified,
2098 by default put half on the left and half on the right. */
2099 if (! boundary_seen)
2100 left_count = nb_buttons - nb_buttons / 2;
2101
2102 wv = xmalloc_widget_value ();
2103 wv->name = dialog_name;
2104 wv->help = Qnil;
2105
2106 /* Frame title: 'Q' = Question, 'I' = Information.
2107 Can also have 'E' = Error if, one day, we want
2108 a popup for errors. */
2109 if (NILP(header))
2110 dialog_name[0] = 'Q';
2111 else
2112 dialog_name[0] = 'I';
2113
2114 /* Dialog boxes use a really stupid name encoding
2115 which specifies how many buttons to use
2116 and how many buttons are on the right. */
2117 dialog_name[1] = '0' + nb_buttons;
2118 dialog_name[2] = 'B';
2119 dialog_name[3] = 'R';
2120 /* Number of buttons to put on the right. */
2121 dialog_name[4] = '0' + nb_buttons - left_count;
2122 dialog_name[5] = 0;
2123 wv->contents = first_wv;
2124 first_wv = wv;
2125 }
2126
2127 /* Actually create the dialog. */
2128 dialog_id = widget_id_tick++;
2129 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2130 f->output_data.w32->widget, 1, 0,
2131 dialog_selection_callback, 0);
2132 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2133
2134 /* Free the widget_value objects we used to specify the contents. */
2135 free_menubar_widget_value_tree (first_wv);
2136
2137 /* No selection has been chosen yet. */
2138 menu_item_selection = 0;
2139
2140 /* Display the menu. */
2141 lw_pop_up_all_widgets (dialog_id);
2142 popup_activated_flag = 1;
2143
2144 /* Process events that apply to the menu. */
2145 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2146
2147 lw_destroy_all_widgets (dialog_id);
2148
2149 /* Find the selected item, and its pane, to return
2150 the proper value. */
2151 if (menu_item_selection != 0)
2152 {
2153 Lisp_Object prefix;
2154
2155 prefix = Qnil;
2156 i = 0;
2157 while (i < menu_items_used)
2158 {
2159 Lisp_Object entry;
2160
2161 if (EQ (AREF (menu_items, i), Qt))
2162 {
2163 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2164 i += MENU_ITEMS_PANE_LENGTH;
2165 }
2166 else
2167 {
2168 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2169 if (menu_item_selection == i)
2170 {
2171 if (keymaps != 0)
2172 {
2173 entry = Fcons (entry, Qnil);
2174 if (!NILP (prefix))
2175 entry = Fcons (prefix, entry);
2176 }
2177 return entry;
2178 }
2179 i += MENU_ITEMS_ITEM_LENGTH;
2180 }
2181 }
2182 }
2183
2184 return Qnil;
2185 }
2186 #endif /* HAVE_DIALOGS */
2187 \f
2188
2189 /* Is this item a separator? */
2190 static int
2191 name_is_separator (name)
2192 char *name;
2193 {
2194 char *start = name;
2195
2196 /* Check if name string consists of only dashes ('-'). */
2197 while (*name == '-') name++;
2198 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2199 or "--deep-shadow". We don't implement them yet, se we just treat
2200 them like normal separators. */
2201 return (*name == '\0' || start + 2 == name);
2202 }
2203
2204
2205 /* Indicate boundary between left and right. */
2206 static int
2207 add_left_right_boundary (HMENU menu)
2208 {
2209 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2210 }
2211
2212 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2213 static void
2214 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2215 {
2216 while (len > 0)
2217 {
2218 int utf16;
2219 if (*src < 0x80)
2220 {
2221 *dest = (WCHAR) *src;
2222 dest++; src++; len--;
2223 }
2224 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2225 else if (*src < 0xC0)
2226 {
2227 src++; len--;
2228 }
2229 /* 2 char UTF-8 sequence. */
2230 else if (*src < 0xE0)
2231 {
2232 *dest = (WCHAR) (((*src & 0x1f) << 6)
2233 | (*(src + 1) & 0x3f));
2234 src += 2; len -= 2; dest++;
2235 }
2236 else if (*src < 0xF0)
2237 {
2238 *dest = (WCHAR) (((*src & 0x0f) << 12)
2239 | ((*(src + 1) & 0x3f) << 6)
2240 | (*(src + 2) & 0x3f));
2241 src += 3; len -= 3; dest++;
2242 }
2243 else /* Not encodable. Insert Unicode Substitution char. */
2244 {
2245 *dest = (WCHAR) 0xfffd;
2246 src++; len--; dest++;
2247 }
2248 }
2249 *dest = 0;
2250 }
2251
2252 static int
2253 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2254 {
2255 UINT fuFlags;
2256 char *out_string;
2257 int return_value;
2258
2259 if (name_is_separator (wv->name))
2260 {
2261 fuFlags = MF_SEPARATOR;
2262 out_string = NULL;
2263 }
2264 else
2265 {
2266 if (wv->enabled)
2267 fuFlags = MF_STRING;
2268 else
2269 fuFlags = MF_STRING | MF_GRAYED;
2270
2271 if (wv->key != NULL)
2272 {
2273 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2274 strcpy (out_string, wv->name);
2275 strcat (out_string, "\t");
2276 strcat (out_string, wv->key);
2277 }
2278 else
2279 out_string = wv->name;
2280
2281 if (item != NULL)
2282 fuFlags = MF_POPUP;
2283 else if (wv->title || wv->call_data == 0)
2284 {
2285 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2286 we can't deallocate the memory otherwise. */
2287 if (get_menu_item_info)
2288 {
2289 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2290 strcpy (out_string, wv->name);
2291 #ifdef MENU_DEBUG
2292 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2293 #endif
2294 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2295 }
2296 else
2297 fuFlags = MF_DISABLED;
2298 }
2299
2300 /* Draw radio buttons and tickboxes. */
2301 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2302 wv->button_type == BUTTON_TYPE_RADIO))
2303 fuFlags |= MF_CHECKED;
2304 else
2305 fuFlags |= MF_UNCHECKED;
2306 }
2307
2308 if (unicode_append_menu && out_string)
2309 {
2310 /* Convert out_string from UTF-8 to UTF-16-LE. */
2311 int utf8_len = strlen (out_string);
2312 WCHAR * utf16_string;
2313 if (fuFlags & MF_OWNERDRAW)
2314 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2315 else
2316 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2317
2318 utf8to16 (out_string, utf8_len, utf16_string);
2319 return_value = unicode_append_menu (menu, fuFlags,
2320 item != NULL ? (UINT) item
2321 : (UINT) wv->call_data,
2322 utf16_string);
2323 if (fuFlags & MF_OWNERDRAW)
2324 local_free (out_string);
2325 }
2326 else
2327 {
2328 return_value =
2329 AppendMenu (menu,
2330 fuFlags,
2331 item != NULL ? (UINT) item : (UINT) wv->call_data,
2332 out_string );
2333 }
2334
2335 /* This must be done after the menu item is created. */
2336 if (!wv->title && wv->call_data != 0)
2337 {
2338 if (set_menu_item_info)
2339 {
2340 MENUITEMINFO info;
2341 bzero (&info, sizeof (info));
2342 info.cbSize = sizeof (info);
2343 info.fMask = MIIM_DATA;
2344
2345 /* Set help string for menu item. Leave it as a Lisp_Object
2346 until it is ready to be displayed, since GC can happen while
2347 menus are active. */
2348 if (!NILP (wv->help))
2349 #ifdef USE_LISP_UNION_TYPE
2350 info.dwItemData = (DWORD) (wv->help).i;
2351 #else
2352 info.dwItemData = (DWORD) (wv->help);
2353 #endif
2354 if (wv->button_type == BUTTON_TYPE_RADIO)
2355 {
2356 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2357 RADIO items, but is not available on NT 3.51 and earlier. */
2358 info.fMask |= MIIM_TYPE | MIIM_STATE;
2359 info.fType = MFT_RADIOCHECK | MFT_STRING;
2360 info.dwTypeData = out_string;
2361 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2362 }
2363
2364 set_menu_item_info (menu,
2365 item != NULL ? (UINT) item : (UINT) wv->call_data,
2366 FALSE, &info);
2367 }
2368 }
2369 return return_value;
2370 }
2371
2372 /* Construct native Windows menu(bar) based on widget_value tree. */
2373 int
2374 fill_in_menu (HMENU menu, widget_value *wv)
2375 {
2376 int items_added = 0;
2377
2378 for ( ; wv != NULL; wv = wv->next)
2379 {
2380 if (wv->contents)
2381 {
2382 HMENU sub_menu = CreatePopupMenu ();
2383
2384 if (sub_menu == NULL)
2385 return 0;
2386
2387 if (!fill_in_menu (sub_menu, wv->contents) ||
2388 !add_menu_item (menu, wv, sub_menu))
2389 {
2390 DestroyMenu (sub_menu);
2391 return 0;
2392 }
2393 }
2394 else
2395 {
2396 if (!add_menu_item (menu, wv, NULL))
2397 return 0;
2398 }
2399 }
2400 return 1;
2401 }
2402
2403 int
2404 popup_activated ()
2405 {
2406 /* popup_activated_flag not actually used on W32 */
2407 return 0;
2408 }
2409
2410 /* Display help string for currently pointed to menu item. Not
2411 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2412 available. */
2413 void
2414 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2415 {
2416 if (get_menu_item_info)
2417 {
2418 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2419 Lisp_Object frame, help;
2420
2421 /* No help echo on owner-draw menu items. */
2422 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2423 help = Qnil;
2424 else
2425 {
2426 MENUITEMINFO info;
2427
2428 bzero (&info, sizeof (info));
2429 info.cbSize = sizeof (info);
2430 info.fMask = MIIM_DATA;
2431 get_menu_item_info (menu, item, FALSE, &info);
2432
2433 #ifdef USE_LISP_UNION_TYPE
2434 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2435 : Qnil;
2436 #else
2437 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2438 #endif
2439 }
2440
2441 /* Store the help echo in the keyboard buffer as the X toolkit
2442 version does, rather than directly showing it. This seems to
2443 solve the GC problems that were present when we based the
2444 Windows code on the non-toolkit version. */
2445 if (f)
2446 {
2447 XSETFRAME (frame, f);
2448 kbd_buffer_store_help_event (frame, help);
2449 }
2450 else
2451 /* X version has a loop through frames here, which doesn't
2452 appear to do anything, unless it has some side effect. */
2453 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2454 }
2455 }
2456
2457 /* Free memory used by owner-drawn strings. */
2458 static void
2459 w32_free_submenu_strings (menu)
2460 HMENU menu;
2461 {
2462 int i, num = GetMenuItemCount (menu);
2463 for (i = 0; i < num; i++)
2464 {
2465 MENUITEMINFO info;
2466 bzero (&info, sizeof (info));
2467 info.cbSize = sizeof (info);
2468 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2469
2470 get_menu_item_info (menu, i, TRUE, &info);
2471
2472 /* Owner-drawn names are held in dwItemData. */
2473 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2474 {
2475 #ifdef MENU_DEBUG
2476 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2477 #endif
2478 local_free (info.dwItemData);
2479 }
2480
2481 /* Recurse down submenus. */
2482 if (info.hSubMenu)
2483 w32_free_submenu_strings (info.hSubMenu);
2484 }
2485 }
2486
2487 void
2488 w32_free_menu_strings (hwnd)
2489 HWND hwnd;
2490 {
2491 HMENU menu = current_popup_menu;
2492
2493 if (get_menu_item_info)
2494 {
2495 /* If there is no popup menu active, free the strings from the frame's
2496 menubar. */
2497 if (!menu)
2498 menu = GetMenu (hwnd);
2499
2500 if (menu)
2501 w32_free_submenu_strings (menu);
2502 }
2503
2504 current_popup_menu = NULL;
2505 }
2506
2507 #endif /* HAVE_MENUS */
2508
2509 void syms_of_w32menu ()
2510 {
2511 globals_of_w32menu ();
2512 staticpro (&menu_items);
2513 menu_items = Qnil;
2514
2515 current_popup_menu = NULL;
2516
2517 Qdebug_on_next_call = intern ("debug-on-next-call");
2518 staticpro (&Qdebug_on_next_call);
2519
2520 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2521 doc: /* Frame for which we are updating a menu.
2522 The enable predicate for a menu command should check this variable. */);
2523 Vmenu_updating_frame = Qnil;
2524
2525 defsubr (&Sx_popup_menu);
2526 #ifdef HAVE_MENUS
2527 defsubr (&Sx_popup_dialog);
2528 #endif
2529 }
2530
2531 /*
2532 globals_of_w32menu is used to initialize those global variables that
2533 must always be initialized on startup even when the global variable
2534 initialized is non zero (see the function main in emacs.c).
2535 globals_of_w32menu is called from syms_of_w32menu when the global
2536 variable initialized is 0 and directly from main when initialized
2537 is non zero.
2538 */
2539 void globals_of_w32menu ()
2540 {
2541 /* See if Get/SetMenuItemInfo functions are available. */
2542 HMODULE user32 = GetModuleHandle ("user32.dll");
2543 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2544 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2545 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2546 }
2547
2548 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2549 (do not change this comment) */