]> code.delx.au - gnu-emacs/blob - src/w32menu.c
(cfstring_create_with_string) [TARGET_API_MAC_CARBON]: New extern.
[gnu-emacs] / 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, 2, 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 (position, contents)
865 Lisp_Object position, contents;
866 {
867 FRAME_PTR f = NULL;
868 Lisp_Object window;
869
870 check_w32 ();
871
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position, Qt)
874 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
875 || EQ (XCAR (position), Qtool_bar))))
876 {
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f = SELECTED_FRAME ();
880 Lisp_Object bar_window;
881 enum scroll_bar_part part;
882 unsigned long time;
883 Lisp_Object x, y;
884
885 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
886
887 if (new_f != 0)
888 XSETFRAME (window, new_f);
889 else
890 window = selected_window;
891 #endif
892 window = selected_window;
893 }
894 else if (CONSP (position))
895 {
896 Lisp_Object tem;
897 tem = Fcar (position);
898 if (CONSP (tem))
899 window = Fcar (Fcdr (position));
900 else
901 {
902 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
903 window = Fcar (tem); /* POSN_WINDOW (tem) */
904 }
905 }
906 else if (WINDOWP (position) || FRAMEP (position))
907 window = position;
908 else
909 window = Qnil;
910
911 /* Decode where to put the menu. */
912
913 if (FRAMEP (window))
914 f = XFRAME (window);
915 else if (WINDOWP (window))
916 {
917 CHECK_LIVE_WINDOW (window);
918 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
919 }
920 else
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window);
924
925 #ifndef HAVE_DIALOGS
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
928 {
929 Lisp_Object x, y, frame, newpos;
930 XSETFRAME (frame, f);
931 XSETINT (x, x_pixel_width (f) / 2);
932 XSETINT (y, x_pixel_height (f) / 2);
933 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
934
935 return Fx_popup_menu (newpos,
936 Fcons (Fcar (contents), Fcons (contents, Qnil)));
937 }
938 #else /* HAVE_DIALOGS */
939 {
940 Lisp_Object title;
941 char *error_name;
942 Lisp_Object selection;
943
944 /* Decode the dialog items from what was specified. */
945 title = Fcar (contents);
946 CHECK_STRING (title);
947
948 list_of_panes (Fcons (contents, Qnil));
949
950 /* Display them in a dialog box. */
951 BLOCK_INPUT;
952 selection = w32_dialog_show (f, 0, title, &error_name);
953 UNBLOCK_INPUT;
954
955 discard_menu_items ();
956
957 if (error_name) error (error_name);
958 return selection;
959 }
960 #endif /* HAVE_DIALOGS */
961 }
962
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
966
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
970
971 But first we recompute the menu bar contents (the whole tree).
972
973 This way we can safely execute Lisp code. */
974
975 void
976 x_activate_menubar (f)
977 FRAME_PTR f;
978 {
979 set_frame_menubar (f, 0, 1);
980
981 /* Lock out further menubar changes while active. */
982 f->output_data.w32->menubar_active = 1;
983
984 /* Signal input thread to return from WM_INITMENU. */
985 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
986 }
987
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
992
993 void
994 menubar_selection_callback (FRAME_PTR f, void * client_data)
995 {
996 Lisp_Object prefix, entry;
997 Lisp_Object vector;
998 Lisp_Object *subprefix_stack;
999 int submenu_depth = 0;
1000 int i;
1001
1002 if (!f)
1003 return;
1004 entry = Qnil;
1005 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1006 vector = f->menu_bar_vector;
1007 prefix = Qnil;
1008 i = 0;
1009 while (i < f->menu_bar_items_used)
1010 {
1011 if (EQ (AREF (vector, i), Qnil))
1012 {
1013 subprefix_stack[submenu_depth++] = prefix;
1014 prefix = entry;
1015 i++;
1016 }
1017 else if (EQ (AREF (vector, i), Qlambda))
1018 {
1019 prefix = subprefix_stack[--submenu_depth];
1020 i++;
1021 }
1022 else if (EQ (AREF (vector, i), Qt))
1023 {
1024 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1025 i += MENU_ITEMS_PANE_LENGTH;
1026 }
1027 else
1028 {
1029 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT) client_data == i)
1033 {
1034 int j;
1035 struct input_event buf;
1036 Lisp_Object frame;
1037 EVENT_INIT (buf);
1038
1039 XSETFRAME (frame, f);
1040 buf.kind = MENU_BAR_EVENT;
1041 buf.frame_or_window = frame;
1042 buf.arg = frame;
1043 kbd_buffer_store_event (&buf);
1044
1045 for (j = 0; j < submenu_depth; j++)
1046 if (!NILP (subprefix_stack[j]))
1047 {
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = subprefix_stack[j];
1051 kbd_buffer_store_event (&buf);
1052 }
1053
1054 if (!NILP (prefix))
1055 {
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = prefix;
1059 kbd_buffer_store_event (&buf);
1060 }
1061
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = entry;
1065 kbd_buffer_store_event (&buf);
1066
1067 /* Free memory used by owner-drawn and help-echo strings. */
1068 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1069 f->output_data.w32->menu_command_in_progress = 0;
1070 f->output_data.w32->menubar_active = 0;
1071 return;
1072 }
1073 i += MENU_ITEMS_ITEM_LENGTH;
1074 }
1075 }
1076 /* Free memory used by owner-drawn and help-echo strings. */
1077 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1078 f->output_data.w32->menu_command_in_progress = 0;
1079 f->output_data.w32->menubar_active = 0;
1080 }
1081
1082 /* Allocate a widget_value, blocking input. */
1083
1084 widget_value *
1085 xmalloc_widget_value ()
1086 {
1087 widget_value *value;
1088
1089 BLOCK_INPUT;
1090 value = malloc_widget_value ();
1091 UNBLOCK_INPUT;
1092
1093 return value;
1094 }
1095
1096 /* This recursively calls free_widget_value on the tree of widgets.
1097 It must free all data that was malloc'ed for these widget_values.
1098 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1099 must be left alone. */
1100
1101 void
1102 free_menubar_widget_value_tree (wv)
1103 widget_value *wv;
1104 {
1105 if (! wv) return;
1106
1107 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1108
1109 if (wv->contents && (wv->contents != (widget_value*)1))
1110 {
1111 free_menubar_widget_value_tree (wv->contents);
1112 wv->contents = (widget_value *) 0xDEADBEEF;
1113 }
1114 if (wv->next)
1115 {
1116 free_menubar_widget_value_tree (wv->next);
1117 wv->next = (widget_value *) 0xDEADBEEF;
1118 }
1119 BLOCK_INPUT;
1120 free_widget_value (wv);
1121 UNBLOCK_INPUT;
1122 }
1123 \f
1124 /* Set up data i menu_items for a menu bar item
1125 whose event type is ITEM_KEY (with string ITEM_NAME)
1126 and whose contents come from the list of keymaps MAPS. */
1127
1128 static int
1129 parse_single_submenu (item_key, item_name, maps)
1130 Lisp_Object item_key, item_name, maps;
1131 {
1132 Lisp_Object length;
1133 int len;
1134 Lisp_Object *mapvec;
1135 int i;
1136 int top_level_items = 0;
1137
1138 length = Flength (maps);
1139 len = XINT (length);
1140
1141 /* Convert the list MAPS into a vector MAPVEC. */
1142 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1143 for (i = 0; i < len; i++)
1144 {
1145 mapvec[i] = Fcar (maps);
1146 maps = Fcdr (maps);
1147 }
1148
1149 /* Loop over the given keymaps, making a pane for each map.
1150 But don't make a pane that is empty--ignore that map instead. */
1151 for (i = 0; i < len; i++)
1152 {
1153 if (SYMBOLP (mapvec[i])
1154 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1155 {
1156 /* Here we have a command at top level in the menu bar
1157 as opposed to a submenu. */
1158 top_level_items = 1;
1159 push_menu_pane (Qnil, Qnil);
1160 push_menu_item (item_name, Qt, item_key, mapvec[i],
1161 Qnil, Qnil, Qnil, Qnil);
1162 }
1163 else
1164 {
1165 Lisp_Object prompt;
1166 prompt = Fkeymap_prompt (mapvec[i]);
1167 single_keymap_panes (mapvec[i],
1168 !NILP (prompt) ? prompt : item_name,
1169 item_key, 0, 10);
1170 }
1171 }
1172
1173 return top_level_items;
1174 }
1175
1176
1177 /* Create a tree of widget_value objects
1178 representing the panes and items
1179 in menu_items starting at index START, up to index END. */
1180
1181 static widget_value *
1182 digest_single_submenu (start, end, top_level_items)
1183 int start, end, top_level_items;
1184 {
1185 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1186 int i;
1187 int submenu_depth = 0;
1188 widget_value **submenu_stack;
1189
1190 submenu_stack
1191 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1192 wv = xmalloc_widget_value ();
1193 wv->name = "menu";
1194 wv->value = 0;
1195 wv->enabled = 1;
1196 wv->button_type = BUTTON_TYPE_NONE;
1197 wv->help = Qnil;
1198 first_wv = wv;
1199 save_wv = 0;
1200 prev_wv = 0;
1201
1202 /* Loop over all panes and items made by the preceding call
1203 to parse_single_submenu and construct a tree of widget_value objects.
1204 Ignore the panes and items used by previous calls to
1205 digest_single_submenu, even though those are also in menu_items. */
1206 i = start;
1207 while (i < end)
1208 {
1209 if (EQ (AREF (menu_items, i), Qnil))
1210 {
1211 submenu_stack[submenu_depth++] = save_wv;
1212 save_wv = prev_wv;
1213 prev_wv = 0;
1214 i++;
1215 }
1216 else if (EQ (AREF (menu_items, i), Qlambda))
1217 {
1218 prev_wv = save_wv;
1219 save_wv = submenu_stack[--submenu_depth];
1220 i++;
1221 }
1222 else if (EQ (AREF (menu_items, i), Qt)
1223 && submenu_depth != 0)
1224 i += MENU_ITEMS_PANE_LENGTH;
1225 /* Ignore a nil in the item list.
1226 It's meaningful only for dialog boxes. */
1227 else if (EQ (AREF (menu_items, i), Qquote))
1228 i += 1;
1229 else if (EQ (AREF (menu_items, i), Qt))
1230 {
1231 /* Create a new pane. */
1232 Lisp_Object pane_name, prefix;
1233 char *pane_string;
1234
1235 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1236 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1237
1238 if (STRINGP (pane_name))
1239 {
1240 if (unicode_append_menu)
1241 /* Encode as UTF-8 for now. */
1242 pane_name = ENCODE_UTF_8 (pane_name);
1243 else if (STRING_MULTIBYTE (pane_name))
1244 pane_name = ENCODE_SYSTEM (pane_name);
1245
1246 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1247 }
1248
1249 pane_string = (NILP (pane_name)
1250 ? "" : (char *) SDATA (pane_name));
1251 /* If there is just one top-level pane, put all its items directly
1252 under the top-level menu. */
1253 if (menu_items_n_panes == 1)
1254 pane_string = "";
1255
1256 /* If the pane has a meaningful name,
1257 make the pane a top-level menu item
1258 with its items as a submenu beneath it. */
1259 if (strcmp (pane_string, ""))
1260 {
1261 wv = xmalloc_widget_value ();
1262 if (save_wv)
1263 save_wv->next = wv;
1264 else
1265 first_wv->contents = wv;
1266 wv->lname = pane_name;
1267 /* Set value to 1 so update_submenu_strings can handle '@' */
1268 wv->value = (char *) 1;
1269 wv->enabled = 1;
1270 wv->button_type = BUTTON_TYPE_NONE;
1271 wv->help = Qnil;
1272 }
1273 save_wv = wv;
1274 prev_wv = 0;
1275 i += MENU_ITEMS_PANE_LENGTH;
1276 }
1277 else
1278 {
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name, enable, descrip, def, type, selected;
1281 Lisp_Object help;
1282
1283 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1284 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1285 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1286 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1287 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1288 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1289 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1290
1291 if (STRINGP (item_name))
1292 {
1293 if (unicode_append_menu)
1294 item_name = ENCODE_UTF_8 (item_name);
1295 else if (STRING_MULTIBYTE (item_name))
1296 item_name = ENCODE_SYSTEM (item_name);
1297
1298 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1299 }
1300
1301 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1302 {
1303 descrip = ENCODE_SYSTEM (descrip);
1304 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1305 }
1306
1307 wv = xmalloc_widget_value ();
1308 if (prev_wv)
1309 prev_wv->next = wv;
1310 else
1311 save_wv->contents = wv;
1312
1313 wv->lname = item_name;
1314 if (!NILP (descrip))
1315 wv->lkey = descrip;
1316 wv->value = 0;
1317 /* The EMACS_INT cast avoids a warning. There's no problem
1318 as long as pointers have enough bits to hold small integers. */
1319 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1320 wv->enabled = !NILP (enable);
1321
1322 if (NILP (type))
1323 wv->button_type = BUTTON_TYPE_NONE;
1324 else if (EQ (type, QCradio))
1325 wv->button_type = BUTTON_TYPE_RADIO;
1326 else if (EQ (type, QCtoggle))
1327 wv->button_type = BUTTON_TYPE_TOGGLE;
1328 else
1329 abort ();
1330
1331 wv->selected = !NILP (selected);
1332 if (!STRINGP (help))
1333 help = Qnil;
1334
1335 wv->help = help;
1336
1337 prev_wv = wv;
1338
1339 i += MENU_ITEMS_ITEM_LENGTH;
1340 }
1341 }
1342
1343 /* If we have just one "menu item"
1344 that was originally a button, return it by itself. */
1345 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1346 {
1347 wv = first_wv->contents;
1348 free_widget_value (first_wv);
1349 return wv;
1350 }
1351
1352 return first_wv;
1353 }
1354
1355
1356 /* Walk through the widget_value tree starting at FIRST_WV and update
1357 the char * pointers from the corresponding lisp values.
1358 We do this after building the whole tree, since GC may happen while the
1359 tree is constructed, and small strings are relocated. So we must wait
1360 until no GC can happen before storing pointers into lisp values. */
1361 static void
1362 update_submenu_strings (first_wv)
1363 widget_value *first_wv;
1364 {
1365 widget_value *wv;
1366
1367 for (wv = first_wv; wv; wv = wv->next)
1368 {
1369 if (wv->lname && ! NILP (wv->lname))
1370 {
1371 wv->name = SDATA (wv->lname);
1372
1373 /* Ignore the @ that means "separate pane".
1374 This is a kludge, but this isn't worth more time. */
1375 if (wv->value == (char *)1)
1376 {
1377 if (wv->name[0] == '@')
1378 wv->name++;
1379 wv->value = 0;
1380 }
1381 }
1382
1383 if (wv->lkey && ! NILP (wv->lkey))
1384 wv->key = SDATA (wv->lkey);
1385
1386 if (wv->contents)
1387 update_submenu_strings (wv->contents);
1388 }
1389 }
1390
1391 \f
1392 /* Set the contents of the menubar widgets of frame F.
1393 The argument FIRST_TIME is currently ignored;
1394 it is set the first time this is called, from initialize_frame_menubar. */
1395
1396 void
1397 set_frame_menubar (f, first_time, deep_p)
1398 FRAME_PTR f;
1399 int first_time;
1400 int deep_p;
1401 {
1402 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1403 Lisp_Object items;
1404 widget_value *wv, *first_wv, *prev_wv = 0;
1405 int i, last_i;
1406 int *submenu_start, *submenu_end;
1407 int *submenu_top_level_items, *submenu_n_panes;
1408
1409 /* We must not change the menubar when actually in use. */
1410 if (f->output_data.w32->menubar_active)
1411 return;
1412
1413 XSETFRAME (Vmenu_updating_frame, f);
1414
1415 if (! menubar_widget)
1416 deep_p = 1;
1417 else if (pending_menu_activation && !deep_p)
1418 deep_p = 1;
1419
1420 if (deep_p)
1421 {
1422 /* Make a widget-value tree representing the entire menu trees. */
1423
1424 struct buffer *prev = current_buffer;
1425 Lisp_Object buffer;
1426 int specpdl_count = SPECPDL_INDEX ();
1427 int previous_menu_items_used = f->menu_bar_items_used;
1428 Lisp_Object *previous_items
1429 = (Lisp_Object *) alloca (previous_menu_items_used
1430 * sizeof (Lisp_Object));
1431
1432 /* If we are making a new widget, its contents are empty,
1433 do always reinitialize them. */
1434 if (! menubar_widget)
1435 previous_menu_items_used = 0;
1436
1437 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1438 specbind (Qinhibit_quit, Qt);
1439 /* Don't let the debugger step into this code
1440 because it is not reentrant. */
1441 specbind (Qdebug_on_next_call, Qnil);
1442
1443 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1444 if (NILP (Voverriding_local_map_menu_flag))
1445 {
1446 specbind (Qoverriding_terminal_local_map, Qnil);
1447 specbind (Qoverriding_local_map, Qnil);
1448 }
1449
1450 set_buffer_internal_1 (XBUFFER (buffer));
1451
1452 /* Run the Lucid hook. */
1453 safe_run_hooks (Qactivate_menubar_hook);
1454 /* If it has changed current-menubar from previous value,
1455 really recompute the menubar from the value. */
1456 if (! NILP (Vlucid_menu_bar_dirty_flag))
1457 call0 (Qrecompute_lucid_menubar);
1458 safe_run_hooks (Qmenu_bar_update_hook);
1459 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1460
1461 items = FRAME_MENU_BAR_ITEMS (f);
1462
1463 /* Save the frame's previous menu bar contents data. */
1464 if (previous_menu_items_used)
1465 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1466 previous_menu_items_used * sizeof (Lisp_Object));
1467
1468 /* Fill in menu_items with the current menu bar contents.
1469 This can evaluate Lisp code. */
1470 menu_items = f->menu_bar_vector;
1471 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1472 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1473 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1474 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1475 submenu_top_level_items
1476 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1477 init_menu_items ();
1478 for (i = 0; i < ASIZE (items); i += 4)
1479 {
1480 Lisp_Object key, string, maps;
1481
1482 last_i = i;
1483
1484 key = AREF (items, i);
1485 string = AREF (items, i + 1);
1486 maps = AREF (items, i + 2);
1487 if (NILP (string))
1488 break;
1489
1490 submenu_start[i] = menu_items_used;
1491
1492 menu_items_n_panes = 0;
1493 submenu_top_level_items[i]
1494 = parse_single_submenu (key, string, maps);
1495 submenu_n_panes[i] = menu_items_n_panes;
1496
1497 submenu_end[i] = menu_items_used;
1498 }
1499
1500 finish_menu_items ();
1501
1502 /* Convert menu_items into widget_value trees
1503 to display the menu. This cannot evaluate Lisp code. */
1504
1505 wv = xmalloc_widget_value ();
1506 wv->name = "menubar";
1507 wv->value = 0;
1508 wv->enabled = 1;
1509 wv->button_type = BUTTON_TYPE_NONE;
1510 wv->help = Qnil;
1511 first_wv = wv;
1512
1513 for (i = 0; i < last_i; i += 4)
1514 {
1515 menu_items_n_panes = submenu_n_panes[i];
1516 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1517 submenu_top_level_items[i]);
1518 if (prev_wv)
1519 prev_wv->next = wv;
1520 else
1521 first_wv->contents = wv;
1522 /* Don't set wv->name here; GC during the loop might relocate it. */
1523 wv->enabled = 1;
1524 wv->button_type = BUTTON_TYPE_NONE;
1525 prev_wv = wv;
1526 }
1527
1528 set_buffer_internal_1 (prev);
1529 unbind_to (specpdl_count, Qnil);
1530
1531 /* If there has been no change in the Lisp-level contents
1532 of the menu bar, skip redisplaying it. Just exit. */
1533
1534 for (i = 0; i < previous_menu_items_used; i++)
1535 if (menu_items_used == i
1536 || (!EQ (previous_items[i], AREF (menu_items, i))))
1537 break;
1538 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1539 {
1540 free_menubar_widget_value_tree (first_wv);
1541 menu_items = Qnil;
1542
1543 return;
1544 }
1545
1546 /* Now GC cannot happen during the lifetime of the widget_value,
1547 so it's safe to store data from a Lisp_String, as long as
1548 local copies are made when the actual menu is created.
1549 Windows takes care of this for normal string items, but
1550 not for owner-drawn items or additional item-info. */
1551 wv = first_wv->contents;
1552 for (i = 0; i < ASIZE (items); i += 4)
1553 {
1554 Lisp_Object string;
1555 string = AREF (items, i + 1);
1556 if (NILP (string))
1557 break;
1558 wv->name = (char *) SDATA (string);
1559 update_submenu_strings (wv->contents);
1560 wv = wv->next;
1561 }
1562
1563 f->menu_bar_vector = menu_items;
1564 f->menu_bar_items_used = menu_items_used;
1565 menu_items = Qnil;
1566 }
1567 else
1568 {
1569 /* Make a widget-value tree containing
1570 just the top level menu bar strings. */
1571
1572 wv = xmalloc_widget_value ();
1573 wv->name = "menubar";
1574 wv->value = 0;
1575 wv->enabled = 1;
1576 wv->button_type = BUTTON_TYPE_NONE;
1577 wv->help = Qnil;
1578 first_wv = wv;
1579
1580 items = FRAME_MENU_BAR_ITEMS (f);
1581 for (i = 0; i < ASIZE (items); i += 4)
1582 {
1583 Lisp_Object string;
1584
1585 string = AREF (items, i + 1);
1586 if (NILP (string))
1587 break;
1588
1589 wv = xmalloc_widget_value ();
1590 wv->name = (char *) SDATA (string);
1591 wv->value = 0;
1592 wv->enabled = 1;
1593 wv->button_type = BUTTON_TYPE_NONE;
1594 wv->help = Qnil;
1595 /* This prevents lwlib from assuming this
1596 menu item is really supposed to be empty. */
1597 /* The EMACS_INT cast avoids a warning.
1598 This value just has to be different from small integers. */
1599 wv->call_data = (void *) (EMACS_INT) (-1);
1600
1601 if (prev_wv)
1602 prev_wv->next = wv;
1603 else
1604 first_wv->contents = wv;
1605 prev_wv = wv;
1606 }
1607
1608 /* Forget what we thought we knew about what is in the
1609 detailed contents of the menu bar menus.
1610 Changing the top level always destroys the contents. */
1611 f->menu_bar_items_used = 0;
1612 }
1613
1614 /* Create or update the menu bar widget. */
1615
1616 BLOCK_INPUT;
1617
1618 if (menubar_widget)
1619 {
1620 /* Empty current menubar, rather than creating a fresh one. */
1621 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1622 ;
1623 }
1624 else
1625 {
1626 menubar_widget = CreateMenu ();
1627 }
1628 fill_in_menu (menubar_widget, first_wv->contents);
1629
1630 free_menubar_widget_value_tree (first_wv);
1631
1632 {
1633 HMENU old_widget = f->output_data.w32->menubar_widget;
1634
1635 f->output_data.w32->menubar_widget = menubar_widget;
1636 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1637 /* Causes flicker when menu bar is updated
1638 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1639
1640 /* Force the window size to be recomputed so that the frame's text
1641 area remains the same, if menubar has just been created. */
1642 if (old_widget == NULL)
1643 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1644 }
1645
1646 UNBLOCK_INPUT;
1647 }
1648
1649 /* Called from Fx_create_frame to create the initial menubar of a frame
1650 before it is mapped, so that the window is mapped with the menubar already
1651 there instead of us tacking it on later and thrashing the window after it
1652 is visible. */
1653
1654 void
1655 initialize_frame_menubar (f)
1656 FRAME_PTR f;
1657 {
1658 /* This function is called before the first chance to redisplay
1659 the frame. It has to be, so the frame will have the right size. */
1660 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1661 set_frame_menubar (f, 1, 1);
1662 }
1663
1664 /* Get rid of the menu bar of frame F, and free its storage.
1665 This is used when deleting a frame, and when turning off the menu bar. */
1666
1667 void
1668 free_frame_menubar (f)
1669 FRAME_PTR f;
1670 {
1671 BLOCK_INPUT;
1672
1673 {
1674 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1675 SetMenu (FRAME_W32_WINDOW (f), NULL);
1676 f->output_data.w32->menubar_widget = NULL;
1677 DestroyMenu (old);
1678 }
1679
1680 UNBLOCK_INPUT;
1681 }
1682
1683 \f
1684 /* w32_menu_show actually displays a menu using the panes and items in
1685 menu_items and returns the value selected from it; we assume input
1686 is blocked by the caller. */
1687
1688 /* F is the frame the menu is for.
1689 X and Y are the frame-relative specified position,
1690 relative to the inside upper left corner of the frame F.
1691 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1692 KEYMAPS is 1 if this menu was specified with keymaps;
1693 in that case, we return a list containing the chosen item's value
1694 and perhaps also the pane's prefix.
1695 TITLE is the specified menu title.
1696 ERROR is a place to store an error message string in case of failure.
1697 (We return nil on failure, but the value doesn't actually matter.) */
1698
1699 static Lisp_Object
1700 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1701 FRAME_PTR f;
1702 int x;
1703 int y;
1704 int for_click;
1705 int keymaps;
1706 Lisp_Object title;
1707 char **error;
1708 {
1709 int i;
1710 int menu_item_selection;
1711 HMENU menu;
1712 POINT pos;
1713 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1714 widget_value **submenu_stack
1715 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1716 Lisp_Object *subprefix_stack
1717 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1718 int submenu_depth = 0;
1719 int first_pane;
1720
1721 *error = NULL;
1722
1723 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1724 {
1725 *error = "Empty menu";
1726 return Qnil;
1727 }
1728
1729 /* Create a tree of widget_value objects
1730 representing the panes and their items. */
1731 wv = xmalloc_widget_value ();
1732 wv->name = "menu";
1733 wv->value = 0;
1734 wv->enabled = 1;
1735 wv->button_type = BUTTON_TYPE_NONE;
1736 wv->help = Qnil;
1737 first_wv = wv;
1738 first_pane = 1;
1739
1740 /* Loop over all panes and items, filling in the tree. */
1741 i = 0;
1742 while (i < menu_items_used)
1743 {
1744 if (EQ (AREF (menu_items, i), Qnil))
1745 {
1746 submenu_stack[submenu_depth++] = save_wv;
1747 save_wv = prev_wv;
1748 prev_wv = 0;
1749 first_pane = 1;
1750 i++;
1751 }
1752 else if (EQ (AREF (menu_items, i), Qlambda))
1753 {
1754 prev_wv = save_wv;
1755 save_wv = submenu_stack[--submenu_depth];
1756 first_pane = 0;
1757 i++;
1758 }
1759 else if (EQ (AREF (menu_items, i), Qt)
1760 && submenu_depth != 0)
1761 i += MENU_ITEMS_PANE_LENGTH;
1762 /* Ignore a nil in the item list.
1763 It's meaningful only for dialog boxes. */
1764 else if (EQ (AREF (menu_items, i), Qquote))
1765 i += 1;
1766 else if (EQ (AREF (menu_items, i), Qt))
1767 {
1768 /* Create a new pane. */
1769 Lisp_Object pane_name, prefix;
1770 char *pane_string;
1771 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1772 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1773
1774 if (STRINGP (pane_name))
1775 {
1776 if (unicode_append_menu)
1777 pane_name = ENCODE_UTF_8 (pane_name);
1778 else if (STRING_MULTIBYTE (pane_name))
1779 pane_name = ENCODE_SYSTEM (pane_name);
1780
1781 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1782 }
1783
1784 pane_string = (NILP (pane_name)
1785 ? "" : (char *) SDATA (pane_name));
1786 /* If there is just one top-level pane, put all its items directly
1787 under the top-level menu. */
1788 if (menu_items_n_panes == 1)
1789 pane_string = "";
1790
1791 /* If the pane has a meaningful name,
1792 make the pane a top-level menu item
1793 with its items as a submenu beneath it. */
1794 if (!keymaps && strcmp (pane_string, ""))
1795 {
1796 wv = xmalloc_widget_value ();
1797 if (save_wv)
1798 save_wv->next = wv;
1799 else
1800 first_wv->contents = wv;
1801 wv->name = pane_string;
1802 if (keymaps && !NILP (prefix))
1803 wv->name++;
1804 wv->value = 0;
1805 wv->enabled = 1;
1806 wv->button_type = BUTTON_TYPE_NONE;
1807 wv->help = Qnil;
1808 save_wv = wv;
1809 prev_wv = 0;
1810 }
1811 else if (first_pane)
1812 {
1813 save_wv = wv;
1814 prev_wv = 0;
1815 }
1816 first_pane = 0;
1817 i += MENU_ITEMS_PANE_LENGTH;
1818 }
1819 else
1820 {
1821 /* Create a new item within current pane. */
1822 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1823
1824 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1825 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1826 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1827 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1828 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1829 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1830 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1831
1832 if (STRINGP (item_name))
1833 {
1834 if (unicode_append_menu)
1835 item_name = ENCODE_UTF_8 (item_name);
1836 else if (STRING_MULTIBYTE (item_name))
1837 item_name = ENCODE_SYSTEM (item_name);
1838
1839 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1840 }
1841
1842 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1843 {
1844 descrip = ENCODE_SYSTEM (descrip);
1845 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1846 }
1847
1848 wv = xmalloc_widget_value ();
1849 if (prev_wv)
1850 prev_wv->next = wv;
1851 else
1852 save_wv->contents = wv;
1853 wv->name = (char *) SDATA (item_name);
1854 if (!NILP (descrip))
1855 wv->key = (char *) SDATA (descrip);
1856 wv->value = 0;
1857 /* Use the contents index as call_data, since we are
1858 restricted to 16-bits. */
1859 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1860 wv->enabled = !NILP (enable);
1861
1862 if (NILP (type))
1863 wv->button_type = BUTTON_TYPE_NONE;
1864 else if (EQ (type, QCtoggle))
1865 wv->button_type = BUTTON_TYPE_TOGGLE;
1866 else if (EQ (type, QCradio))
1867 wv->button_type = BUTTON_TYPE_RADIO;
1868 else
1869 abort ();
1870
1871 wv->selected = !NILP (selected);
1872 if (!STRINGP (help))
1873 help = Qnil;
1874
1875 wv->help = help;
1876
1877 prev_wv = wv;
1878
1879 i += MENU_ITEMS_ITEM_LENGTH;
1880 }
1881 }
1882
1883 /* Deal with the title, if it is non-nil. */
1884 if (!NILP (title))
1885 {
1886 widget_value *wv_title = xmalloc_widget_value ();
1887 widget_value *wv_sep = xmalloc_widget_value ();
1888
1889 /* Maybe replace this separator with a bitmap or owner-draw item
1890 so that it looks better. Having two separators looks odd. */
1891 wv_sep->name = "--";
1892 wv_sep->next = first_wv->contents;
1893 wv_sep->help = Qnil;
1894
1895 if (unicode_append_menu)
1896 title = ENCODE_UTF_8 (title);
1897 else if (STRING_MULTIBYTE (title))
1898 title = ENCODE_SYSTEM (title);
1899
1900 wv_title->name = (char *) SDATA (title);
1901 wv_title->enabled = TRUE;
1902 wv_title->title = TRUE;
1903 wv_title->button_type = BUTTON_TYPE_NONE;
1904 wv_title->help = Qnil;
1905 wv_title->next = wv_sep;
1906 first_wv->contents = wv_title;
1907 }
1908
1909 /* Actually create the menu. */
1910 current_popup_menu = menu = CreatePopupMenu ();
1911 fill_in_menu (menu, first_wv->contents);
1912
1913 /* Adjust coordinates to be root-window-relative. */
1914 pos.x = x;
1915 pos.y = y;
1916 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1917
1918 /* No selection has been chosen yet. */
1919 menu_item_selection = 0;
1920
1921 /* Display the menu. */
1922 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1923 WM_EMACS_TRACKPOPUPMENU,
1924 (WPARAM)menu, (LPARAM)&pos);
1925
1926 /* Clean up extraneous mouse events which might have been generated
1927 during the call. */
1928 discard_mouse_events ();
1929
1930 /* Free the widget_value objects we used to specify the contents. */
1931 free_menubar_widget_value_tree (first_wv);
1932
1933 DestroyMenu (menu);
1934
1935 /* Find the selected item, and its pane, to return
1936 the proper value. */
1937 if (menu_item_selection != 0)
1938 {
1939 Lisp_Object prefix, entry;
1940
1941 prefix = entry = Qnil;
1942 i = 0;
1943 while (i < menu_items_used)
1944 {
1945 if (EQ (AREF (menu_items, i), Qnil))
1946 {
1947 subprefix_stack[submenu_depth++] = prefix;
1948 prefix = entry;
1949 i++;
1950 }
1951 else if (EQ (AREF (menu_items, i), Qlambda))
1952 {
1953 prefix = subprefix_stack[--submenu_depth];
1954 i++;
1955 }
1956 else if (EQ (AREF (menu_items, i), Qt))
1957 {
1958 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1959 i += MENU_ITEMS_PANE_LENGTH;
1960 }
1961 /* Ignore a nil in the item list.
1962 It's meaningful only for dialog boxes. */
1963 else if (EQ (AREF (menu_items, i), Qquote))
1964 i += 1;
1965 else
1966 {
1967 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1968 if (menu_item_selection == i)
1969 {
1970 if (keymaps != 0)
1971 {
1972 int j;
1973
1974 entry = Fcons (entry, Qnil);
1975 if (!NILP (prefix))
1976 entry = Fcons (prefix, entry);
1977 for (j = submenu_depth - 1; j >= 0; j--)
1978 if (!NILP (subprefix_stack[j]))
1979 entry = Fcons (subprefix_stack[j], entry);
1980 }
1981 return entry;
1982 }
1983 i += MENU_ITEMS_ITEM_LENGTH;
1984 }
1985 }
1986 }
1987
1988 return Qnil;
1989 }
1990 \f
1991
1992 #ifdef HAVE_DIALOGS
1993 static char * button_names [] = {
1994 "button1", "button2", "button3", "button4", "button5",
1995 "button6", "button7", "button8", "button9", "button10" };
1996
1997 static Lisp_Object
1998 w32_dialog_show (f, keymaps, title, error)
1999 FRAME_PTR f;
2000 int keymaps;
2001 Lisp_Object title;
2002 char **error;
2003 {
2004 int i, nb_buttons=0;
2005 char dialog_name[6];
2006 int menu_item_selection;
2007
2008 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2009
2010 /* Number of elements seen so far, before boundary. */
2011 int left_count = 0;
2012 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2013 int boundary_seen = 0;
2014
2015 *error = NULL;
2016
2017 if (menu_items_n_panes > 1)
2018 {
2019 *error = "Multiple panes in dialog box";
2020 return Qnil;
2021 }
2022
2023 /* Create a tree of widget_value objects
2024 representing the text label and buttons. */
2025 {
2026 Lisp_Object pane_name, prefix;
2027 char *pane_string;
2028 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2029 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2030 pane_string = (NILP (pane_name)
2031 ? "" : (char *) SDATA (pane_name));
2032 prev_wv = xmalloc_widget_value ();
2033 prev_wv->value = pane_string;
2034 if (keymaps && !NILP (prefix))
2035 prev_wv->name++;
2036 prev_wv->enabled = 1;
2037 prev_wv->name = "message";
2038 prev_wv->help = Qnil;
2039 first_wv = prev_wv;
2040
2041 /* Loop over all panes and items, filling in the tree. */
2042 i = MENU_ITEMS_PANE_LENGTH;
2043 while (i < menu_items_used)
2044 {
2045
2046 /* Create a new item within current pane. */
2047 Lisp_Object item_name, enable, descrip, help;
2048
2049 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2050 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2051 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2052 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2053
2054 if (NILP (item_name))
2055 {
2056 free_menubar_widget_value_tree (first_wv);
2057 *error = "Submenu in dialog items";
2058 return Qnil;
2059 }
2060 if (EQ (item_name, Qquote))
2061 {
2062 /* This is the boundary between left-side elts
2063 and right-side elts. Stop incrementing right_count. */
2064 boundary_seen = 1;
2065 i++;
2066 continue;
2067 }
2068 if (nb_buttons >= 9)
2069 {
2070 free_menubar_widget_value_tree (first_wv);
2071 *error = "Too many dialog items";
2072 return Qnil;
2073 }
2074
2075 wv = xmalloc_widget_value ();
2076 prev_wv->next = wv;
2077 wv->name = (char *) button_names[nb_buttons];
2078 if (!NILP (descrip))
2079 wv->key = (char *) SDATA (descrip);
2080 wv->value = (char *) SDATA (item_name);
2081 wv->call_data = (void *) &AREF (menu_items, i);
2082 wv->enabled = !NILP (enable);
2083 wv->help = Qnil;
2084 prev_wv = wv;
2085
2086 if (! boundary_seen)
2087 left_count++;
2088
2089 nb_buttons++;
2090 i += MENU_ITEMS_ITEM_LENGTH;
2091 }
2092
2093 /* If the boundary was not specified,
2094 by default put half on the left and half on the right. */
2095 if (! boundary_seen)
2096 left_count = nb_buttons - nb_buttons / 2;
2097
2098 wv = xmalloc_widget_value ();
2099 wv->name = dialog_name;
2100 wv->help = Qnil;
2101
2102 /* Dialog boxes use a really stupid name encoding
2103 which specifies how many buttons to use
2104 and how many buttons are on the right.
2105 The Q means something also. */
2106 dialog_name[0] = 'Q';
2107 dialog_name[1] = '0' + nb_buttons;
2108 dialog_name[2] = 'B';
2109 dialog_name[3] = 'R';
2110 /* Number of buttons to put on the right. */
2111 dialog_name[4] = '0' + nb_buttons - left_count;
2112 dialog_name[5] = 0;
2113 wv->contents = first_wv;
2114 first_wv = wv;
2115 }
2116
2117 /* Actually create the dialog. */
2118 dialog_id = widget_id_tick++;
2119 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2120 f->output_data.w32->widget, 1, 0,
2121 dialog_selection_callback, 0);
2122 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2123
2124 /* Free the widget_value objects we used to specify the contents. */
2125 free_menubar_widget_value_tree (first_wv);
2126
2127 /* No selection has been chosen yet. */
2128 menu_item_selection = 0;
2129
2130 /* Display the menu. */
2131 lw_pop_up_all_widgets (dialog_id);
2132 popup_activated_flag = 1;
2133
2134 /* Process events that apply to the menu. */
2135 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2136
2137 lw_destroy_all_widgets (dialog_id);
2138
2139 /* Find the selected item, and its pane, to return
2140 the proper value. */
2141 if (menu_item_selection != 0)
2142 {
2143 Lisp_Object prefix;
2144
2145 prefix = Qnil;
2146 i = 0;
2147 while (i < menu_items_used)
2148 {
2149 Lisp_Object entry;
2150
2151 if (EQ (AREF (menu_items, i), Qt))
2152 {
2153 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2154 i += MENU_ITEMS_PANE_LENGTH;
2155 }
2156 else
2157 {
2158 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2159 if (menu_item_selection == i)
2160 {
2161 if (keymaps != 0)
2162 {
2163 entry = Fcons (entry, Qnil);
2164 if (!NILP (prefix))
2165 entry = Fcons (prefix, entry);
2166 }
2167 return entry;
2168 }
2169 i += MENU_ITEMS_ITEM_LENGTH;
2170 }
2171 }
2172 }
2173
2174 return Qnil;
2175 }
2176 #endif /* HAVE_DIALOGS */
2177 \f
2178
2179 /* Is this item a separator? */
2180 static int
2181 name_is_separator (name)
2182 char *name;
2183 {
2184 char *start = name;
2185
2186 /* Check if name string consists of only dashes ('-'). */
2187 while (*name == '-') name++;
2188 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2189 or "--deep-shadow". We don't implement them yet, se we just treat
2190 them like normal separators. */
2191 return (*name == '\0' || start + 2 == name);
2192 }
2193
2194
2195 /* Indicate boundary between left and right. */
2196 static int
2197 add_left_right_boundary (HMENU menu)
2198 {
2199 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2200 }
2201
2202 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2203 static void
2204 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2205 {
2206 while (len > 0)
2207 {
2208 int utf16;
2209 if (*src < 0x80)
2210 {
2211 *dest = (WCHAR) *src;
2212 dest++; src++; len--;
2213 }
2214 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2215 else if (*src < 0xC0)
2216 {
2217 src++; len--;
2218 }
2219 /* 2 char UTF-8 sequence. */
2220 else if (*src < 0xE0)
2221 {
2222 *dest = (WCHAR) (((*src & 0x1f) << 6)
2223 | (*(src + 1) & 0x3f));
2224 src += 2; len -= 2; dest++;
2225 }
2226 else if (*src < 0xF0)
2227 {
2228 *dest = (WCHAR) (((*src & 0x0f) << 12)
2229 | ((*(src + 1) & 0x3f) << 6)
2230 | (*(src + 2) & 0x3f));
2231 src += 3; len -= 3; dest++;
2232 }
2233 else /* Not encodable. Insert Unicode Substitution char. */
2234 {
2235 *dest = (WCHAR) 0xfffd;
2236 src++; len--; dest++;
2237 }
2238 }
2239 *dest = 0;
2240 }
2241
2242 static int
2243 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2244 {
2245 UINT fuFlags;
2246 char *out_string;
2247 int return_value;
2248
2249 if (name_is_separator (wv->name))
2250 {
2251 fuFlags = MF_SEPARATOR;
2252 out_string = NULL;
2253 }
2254 else
2255 {
2256 if (wv->enabled)
2257 fuFlags = MF_STRING;
2258 else
2259 fuFlags = MF_STRING | MF_GRAYED;
2260
2261 if (wv->key != NULL)
2262 {
2263 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2264 strcpy (out_string, wv->name);
2265 strcat (out_string, "\t");
2266 strcat (out_string, wv->key);
2267 }
2268 else
2269 out_string = wv->name;
2270
2271 if (item != NULL)
2272 fuFlags = MF_POPUP;
2273 else if (wv->title || wv->call_data == 0)
2274 {
2275 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2276 we can't deallocate the memory otherwise. */
2277 if (get_menu_item_info)
2278 {
2279 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2280 strcpy (out_string, wv->name);
2281 #ifdef MENU_DEBUG
2282 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2283 #endif
2284 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2285 }
2286 else
2287 fuFlags = MF_DISABLED;
2288 }
2289
2290 /* Draw radio buttons and tickboxes. */
2291 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2292 wv->button_type == BUTTON_TYPE_RADIO))
2293 fuFlags |= MF_CHECKED;
2294 else
2295 fuFlags |= MF_UNCHECKED;
2296 }
2297
2298 if (unicode_append_menu && out_string)
2299 {
2300 /* Convert out_string from UTF-8 to UTF-16-LE. */
2301 int utf8_len = strlen (out_string);
2302 WCHAR * utf16_string;
2303 if (fuFlags & MF_OWNERDRAW)
2304 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2305 else
2306 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2307
2308 utf8to16 (out_string, utf8_len, utf16_string);
2309 return_value = unicode_append_menu (menu, fuFlags,
2310 item != NULL ? (UINT) item
2311 : (UINT) wv->call_data,
2312 utf16_string);
2313 if (fuFlags & MF_OWNERDRAW)
2314 local_free (out_string);
2315 }
2316 else
2317 {
2318 return_value =
2319 AppendMenu (menu,
2320 fuFlags,
2321 item != NULL ? (UINT) item : (UINT) wv->call_data,
2322 out_string );
2323 }
2324
2325 /* This must be done after the menu item is created. */
2326 if (!wv->title && wv->call_data != 0)
2327 {
2328 if (set_menu_item_info)
2329 {
2330 MENUITEMINFO info;
2331 bzero (&info, sizeof (info));
2332 info.cbSize = sizeof (info);
2333 info.fMask = MIIM_DATA;
2334
2335 /* Set help string for menu item. Leave it as a Lisp_Object
2336 until it is ready to be displayed, since GC can happen while
2337 menus are active. */
2338 if (!NILP (wv->help))
2339 #ifdef USE_LISP_UNION_TYPE
2340 info.dwItemData = (DWORD) (wv->help).i;
2341 #else
2342 info.dwItemData = (DWORD) (wv->help);
2343 #endif
2344 if (wv->button_type == BUTTON_TYPE_RADIO)
2345 {
2346 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2347 RADIO items, but is not available on NT 3.51 and earlier. */
2348 info.fMask |= MIIM_TYPE | MIIM_STATE;
2349 info.fType = MFT_RADIOCHECK | MFT_STRING;
2350 info.dwTypeData = out_string;
2351 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2352 }
2353
2354 set_menu_item_info (menu,
2355 item != NULL ? (UINT) item : (UINT) wv->call_data,
2356 FALSE, &info);
2357 }
2358 }
2359 return return_value;
2360 }
2361
2362 /* Construct native Windows menu(bar) based on widget_value tree. */
2363 int
2364 fill_in_menu (HMENU menu, widget_value *wv)
2365 {
2366 int items_added = 0;
2367
2368 for ( ; wv != NULL; wv = wv->next)
2369 {
2370 if (wv->contents)
2371 {
2372 HMENU sub_menu = CreatePopupMenu ();
2373
2374 if (sub_menu == NULL)
2375 return 0;
2376
2377 if (!fill_in_menu (sub_menu, wv->contents) ||
2378 !add_menu_item (menu, wv, sub_menu))
2379 {
2380 DestroyMenu (sub_menu);
2381 return 0;
2382 }
2383 }
2384 else
2385 {
2386 if (!add_menu_item (menu, wv, NULL))
2387 return 0;
2388 }
2389 }
2390 return 1;
2391 }
2392
2393 int
2394 popup_activated ()
2395 {
2396 /* popup_activated_flag not actually used on W32 */
2397 return 0;
2398 }
2399
2400 /* Display help string for currently pointed to menu item. Not
2401 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2402 available. */
2403 void
2404 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2405 {
2406 if (get_menu_item_info)
2407 {
2408 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2409 Lisp_Object frame, help;
2410
2411 /* No help echo on owner-draw menu items. */
2412 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2413 help = Qnil;
2414 else
2415 {
2416 MENUITEMINFO info;
2417
2418 bzero (&info, sizeof (info));
2419 info.cbSize = sizeof (info);
2420 info.fMask = MIIM_DATA;
2421 get_menu_item_info (menu, item, FALSE, &info);
2422
2423 #ifdef USE_LISP_UNION_TYPE
2424 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2425 : Qnil;
2426 #else
2427 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2428 #endif
2429 }
2430
2431 /* Store the help echo in the keyboard buffer as the X toolkit
2432 version does, rather than directly showing it. This seems to
2433 solve the GC problems that were present when we based the
2434 Windows code on the non-toolkit version. */
2435 if (f)
2436 {
2437 XSETFRAME (frame, f);
2438 kbd_buffer_store_help_event (frame, help);
2439 }
2440 else
2441 /* X version has a loop through frames here, which doesn't
2442 appear to do anything, unless it has some side effect. */
2443 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2444 }
2445 }
2446
2447 /* Free memory used by owner-drawn strings. */
2448 static void
2449 w32_free_submenu_strings (menu)
2450 HMENU menu;
2451 {
2452 int i, num = GetMenuItemCount (menu);
2453 for (i = 0; i < num; i++)
2454 {
2455 MENUITEMINFO info;
2456 bzero (&info, sizeof (info));
2457 info.cbSize = sizeof (info);
2458 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2459
2460 get_menu_item_info (menu, i, TRUE, &info);
2461
2462 /* Owner-drawn names are held in dwItemData. */
2463 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2464 {
2465 #ifdef MENU_DEBUG
2466 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2467 #endif
2468 local_free (info.dwItemData);
2469 }
2470
2471 /* Recurse down submenus. */
2472 if (info.hSubMenu)
2473 w32_free_submenu_strings (info.hSubMenu);
2474 }
2475 }
2476
2477 void
2478 w32_free_menu_strings (hwnd)
2479 HWND hwnd;
2480 {
2481 HMENU menu = current_popup_menu;
2482
2483 if (get_menu_item_info)
2484 {
2485 /* If there is no popup menu active, free the strings from the frame's
2486 menubar. */
2487 if (!menu)
2488 menu = GetMenu (hwnd);
2489
2490 if (menu)
2491 w32_free_submenu_strings (menu);
2492 }
2493
2494 current_popup_menu = NULL;
2495 }
2496
2497 #endif /* HAVE_MENUS */
2498
2499 void syms_of_w32menu ()
2500 {
2501 globals_of_w32menu ();
2502 staticpro (&menu_items);
2503 menu_items = Qnil;
2504
2505 current_popup_menu = NULL;
2506
2507 Qdebug_on_next_call = intern ("debug-on-next-call");
2508 staticpro (&Qdebug_on_next_call);
2509
2510 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2511 doc: /* Frame for which we are updating a menu.
2512 The enable predicate for a menu command should check this variable. */);
2513 Vmenu_updating_frame = Qnil;
2514
2515 defsubr (&Sx_popup_menu);
2516 #ifdef HAVE_MENUS
2517 defsubr (&Sx_popup_dialog);
2518 #endif
2519 }
2520
2521 /*
2522 globals_of_w32menu is used to initialize those global variables that
2523 must always be initialized on startup even when the global variable
2524 initialized is non zero (see the function main in emacs.c).
2525 globals_of_w32menu is called from syms_of_w32menu when the global
2526 variable initialized is 0 and directly from main when initialized
2527 is non zero.
2528 */
2529 void globals_of_w32menu ()
2530 {
2531 /* See if Get/SetMenuItemInfo functions are available. */
2532 HMODULE user32 = GetModuleHandle ("user32.dll");
2533 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2534 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2535 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2536 }
2537
2538 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2539 (do not change this comment) */