a225eb50175be7e2931e5ce1b8dbca3cb8fff62b
[chise/xemacs-chise.git.1] / src / menubar-x.c
1 /* Implements an elisp-programmable menubar -- X interface.
2    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3    Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: Not in FSF. */
23
24 /* created 16-dec-91 by jwz */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "console-x.h"
30 #include "EmacsManager.h"
31 #include "EmacsFrame.h"
32 #include "EmacsShell.h"
33 #include "gui-x.h"
34
35 #include "buffer.h"
36 #include "commands.h"           /* zmacs_regions */
37 #include "gui.h"
38 #include "events.h"
39 #include "frame.h"
40 #include "opaque.h"
41 #include "window.h"
42
43 static int set_frame_menubar (struct frame *f,
44                               int deep_p,
45                               int first_time_p);
46
47 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
48 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
49
50 #define MENUBAR_TYPE    0
51 #define SUBMENU_TYPE    1
52 #define POPUP_TYPE      2
53
54 \f
55 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
56
57    menu_item_descriptor_to_widget_value() converts a lisp description of a
58    menubar into a tree of widget_value structures.  It allocates widget_values
59    with malloc_widget_value() and allocates other storage only for the `key'
60    slot.  All other slots are filled with pointers to Lisp_String data.  We
61    allocate a widget_value description of the menu or menubar, and hand it to
62    lwlib, which then makes a copy of it, which it manages internally.  We then
63    immediately free our widget_value tree; it will not be referenced again.
64
65    Incremental menu construction callbacks operate just a bit differently.
66    They allocate widget_values and call replace_widget_value_tree() to tell
67    lwlib to destructively modify the incremental stub (subtree) of its
68    separate widget_value tree.
69
70    This function is highly recursive (it follows the menu trees) and may call
71    eval.  The reason we keep pointers to lisp string data instead of copying
72    it and freeing it later is to avoid the speed penalty that would entail
73    (since this needs to be fast, in the simple cases at least).  (The reason
74    we malloc/free the keys slot is because there's not a lisp string around
75    for us to use in that case.)
76
77    Since we keep pointers to lisp strings, and we call eval, we could lose if
78    GC relocates (or frees) those strings.  It's not easy to gc protect the
79    strings because of the recursive nature of this function, and the fact that
80    it returns a data structure that gets freed later.  So...  we do the
81    sleaziest thing possible and inhibit GC for the duration.  This is probably
82    not a big deal...
83
84    We do not have to worry about the pointers to Lisp_String data after
85    this function successfully finishes.  lwlib copies all such data with
86    strdup().  */
87
88 static widget_value *
89 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
90                                         int menu_type, int deep_p,
91                                         int filter_p,
92                                         int depth)
93 {
94   /* This function cannot GC.
95      It is only called from menu_item_descriptor_to_widget_value, which
96      prohibits GC. */
97   /* !!#### This function has not been Mule-ized */
98   int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
99   widget_value *wv;
100   Lisp_Object wv_closure;
101   int count = specpdl_depth ();
102   int partition_seen = 0;
103
104   wv = xmalloc_widget_value ();
105
106   wv_closure = make_opaque_ptr (wv);
107   record_unwind_protect (widget_value_unwind, wv_closure);
108
109   if (STRINGP (desc))
110     {
111       char *string_chars = (char *) XSTRING_DATA (desc);
112       wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
113                   TEXT_TYPE);
114 #if 1
115       /* #### - should internationalize with X resources instead.
116          Not so! --ben */
117       string_chars = GETTEXT (string_chars);
118 #endif
119       if (wv->type == SEPARATOR_TYPE)
120         {
121           wv->value = menu_separator_style (string_chars);
122         }
123       else
124         {
125           wv->name = string_chars;
126           wv->enabled = 1;
127         }
128     }
129   else if (VECTORP (desc))
130     {
131       if (!button_item_to_widget_value (desc, wv, 1,
132                                         (menu_type == MENUBAR_TYPE
133                                          && depth <= 1)))
134         {
135           /* :included form was nil */
136           wv = NULL;
137           goto menu_item_done;
138         }
139     }
140   else if (CONSP (desc))
141     {
142       Lisp_Object incremental_data = desc;
143       widget_value *prev = 0;
144
145       if (STRINGP (XCAR (desc)))
146         {
147           Lisp_Object key, val;
148           Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
149           Lisp_Object accel;
150           int included_spec = 0;
151           wv->type = CASCADE_TYPE;
152           wv->enabled = 1;
153           wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
154
155           accel = menu_name_to_accelerator (wv->name);
156           wv->accel = LISP_TO_VOID (accel);
157
158           desc = Fcdr (desc);
159
160           while (key = Fcar (desc), KEYWORDP (key))
161             {
162               Lisp_Object cascade = desc;
163               desc = Fcdr (desc);
164               if (NILP (desc))
165                 signal_simple_error ("keyword in menu lacks a value",
166                                      cascade);
167               val = Fcar (desc);
168               desc = Fcdr (desc);
169               if (EQ (key, Q_included))
170                 include_p = val, included_spec = 1;
171               else if (EQ (key, Q_config))
172                 config_tag = val;
173               else if (EQ (key, Q_filter))
174                 hook_fn = val;
175               else if (EQ (key, Q_accelerator))
176                 {
177                   if ( SYMBOLP (val)
178                        || CHARP (val))
179                     wv->accel = LISP_TO_VOID (val);
180                   else
181                     signal_simple_error ("bad keyboard accelerator", val);
182                 }
183               else
184                 signal_simple_error ("unknown menu cascade keyword", cascade);
185             }
186
187           if ((!NILP (config_tag)
188                && NILP (Fmemq (config_tag, Vmenubar_configuration)))
189               || (included_spec && NILP (Feval (include_p))))
190             {
191               wv = NULL;
192               goto menu_item_done;
193             }
194           if (!NILP (hook_fn))
195             {
196 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
197               if (filter_p || depth == 0)
198                 {
199 #endif
200                   desc = call1_trapping_errors ("Error in menubar filter",
201                                                 hook_fn, desc);
202                   if (UNBOUNDP (desc))
203                     desc = Qnil;
204 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
205                 }
206               else
207                 {
208                   widget_value *incr_wv = xmalloc_widget_value ();
209                   wv->contents = incr_wv;
210                   incr_wv->type = INCREMENTAL_TYPE;
211                   incr_wv->enabled = 1;
212                   incr_wv->name = wv->name;
213                   /* This is automatically GC protected through
214                      the call to lw_map_widget_values(); no need
215                      to worry. */
216                   incr_wv->call_data = LISP_TO_VOID (incremental_data);
217                   goto menu_item_done;
218                 }
219 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
220             }
221           if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
222             {
223               /* Simply prepend three more widget values to the contents of
224                  the menu: a label, and two separators (to get a double
225                  line). */
226               widget_value *title_wv = xmalloc_widget_value ();
227               widget_value *sep_wv = xmalloc_widget_value ();
228               title_wv->type = TEXT_TYPE;
229               title_wv->name = wv->name;
230               title_wv->enabled = 1;
231               title_wv->next = sep_wv;
232               sep_wv->type = SEPARATOR_TYPE;
233               sep_wv->value = menu_separator_style ("==");
234               sep_wv->next = 0;
235
236               wv->contents = title_wv;
237               prev = sep_wv;
238             }
239         }
240       else if (menubar_root_p)
241         {
242           wv->name = (char *) "menubar";
243           wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
244                                       this is ignored anyway...  */
245         }
246       else
247         {
248           signal_simple_error ("menu name (first element) must be a string",
249                                desc);
250         }
251
252       wv->enabled = 1;
253       if (deep_p || menubar_root_p)
254         {
255           widget_value *next;
256           for (; !NILP (desc); desc = Fcdr (desc))
257             {
258               Lisp_Object child = Fcar (desc);
259               if (menubar_root_p && NILP (child))       /* the partition */
260                 {
261                   if (partition_seen)
262                     error (
263                      "more than one partition (nil) in menubar description");
264                   partition_seen = 1;
265                   next = xmalloc_widget_value ();
266                   next->type = PUSHRIGHT_TYPE;
267                 }
268               else
269                 {
270                   next = menu_item_descriptor_to_widget_value_1
271                     (child, menu_type, deep_p, filter_p, depth + 1);
272                 }
273               if (! next)
274                 continue;
275               else if (prev)
276                 prev->next = next;
277               else
278                 wv->contents = next;
279               prev = next;
280             }
281         }
282       if (deep_p && !wv->contents)
283         wv = NULL;
284     }
285   else if (NILP (desc))
286     error ("nil may not appear in menu descriptions");
287   else
288     signal_simple_error ("unrecognized menu descriptor", desc);
289
290 menu_item_done:
291
292   if (wv)
293     {
294       /* Completed normally.  Clear out the object that widget_value_unwind()
295          will be called with to tell it not to free the wv (as we are
296          returning it.) */
297       set_opaque_ptr (wv_closure, 0);
298     }
299
300   unbind_to (count, Qnil);
301   return wv;
302 }
303
304 static widget_value *
305 menu_item_descriptor_to_widget_value (Lisp_Object desc,
306                                       int menu_type, /* if this is a menubar,
307                                                      popup or sub menu */
308                                       int deep_p,    /*  */
309                                       int filter_p)  /* if :filter forms
310                                                         should run now */
311 {
312   widget_value *wv;
313   int count = specpdl_depth ();
314   record_unwind_protect (restore_gc_inhibit,
315                          make_int (gc_currently_forbidden));
316   gc_currently_forbidden = 1;
317   /* Can't GC! */
318   wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
319                                                filter_p, 0);
320   unbind_to (count, Qnil);
321   return wv;
322 }
323
324
325 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
326 int in_menu_callback;
327
328 static Lisp_Object
329 restore_in_menu_callback (Lisp_Object val)
330 {
331     in_menu_callback = XINT(val);
332     return Qnil;
333 }
334 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
335
336 #if 0
337 /* #### Sort of a hack needed to process Vactivate_menubar_hook
338    correctly wrt buffer-local values.  A correct solution would
339    involve adding a callback mechanism to run_hook().  This function
340    is currently unused.  */
341 static int
342 my_run_hook (Lisp_Object hooksym, int allow_global_p)
343 {
344   /* This function can GC */
345   Lisp_Object tail;
346   Lisp_Object value = Fsymbol_value (hooksym);
347   int changes = 0;
348
349   if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
350     return !EQ (call0 (value), Qt);
351
352   EXTERNAL_LIST_LOOP (tail, value)
353     {
354       if (allow_global_p && EQ (XCAR (tail), Qt))
355         changes |= my_run_hook (Fdefault_value (hooksym), 0);
356       if (!EQ (call0 (XCAR (tail)), Qt))
357         changes = 1;
358     }
359   return changes;
360 }
361 #endif
362
363
364 /* The order in which callbacks are run is funny to say the least.
365    It's sometimes tricky to avoid running a callback twice, and to
366    avoid returning prematurely.  So, this function returns true
367    if the menu's callbacks are no longer gc protected.  So long
368    as we unprotect them before allowing other callbacks to run,
369    everything should be ok.
370
371    The pre_activate_callback() *IS* intentionally called multiple times.
372    If client_data == NULL, then it's being called before the menu is posted.
373    If client_data != NULL, then client_data is a (widget_value *) and
374    client_data->data is a Lisp_Object pointing to a lisp submenu description
375    that must be converted into widget_values.  *client_data is destructively
376    modified.
377
378    #### Stig thinks that there may be a GC problem here due to the
379    fact that pre_activate_callback() is called multiple times, but I
380    think he's wrong.
381
382    */
383
384 static void
385 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
386 {
387   /* This function can GC */
388   struct device *d = get_device_from_display (XtDisplay (widget));
389   struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
390   Lisp_Object frame;
391   int count;
392
393   /* set in lwlib to the time stamp associated with the most recent menu
394      operation */
395   extern Time x_focus_timestamp_really_sucks_fix_me_better;
396
397   if (!f)
398     f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
399   if (!f)
400     return;
401
402   /* make sure f is the selected frame */
403   XSETFRAME (frame, f);
404   Fselect_frame (frame);
405
406   if (client_data)
407     {
408       /* this is an incremental menu construction callback */
409       widget_value *hack_wv = (widget_value *) client_data;
410       Lisp_Object submenu_desc;
411       widget_value *wv;
412
413       assert (hack_wv->type == INCREMENTAL_TYPE);
414       VOID_TO_LISP (submenu_desc, hack_wv->call_data);
415
416       /*
417        * #### Fix the menu code so this isn't necessary.
418        *
419        * Protect against reentering the menu code otherwise we will
420        * crash later when the code gets confused at the state
421        * changes.
422        */
423       count = specpdl_depth ();
424       record_unwind_protect (restore_in_menu_callback,
425                              make_int (in_menu_callback));
426       in_menu_callback = 1;
427       wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
428                                                  1, 0);
429       unbind_to (count, Qnil);
430
431       if (!wv)
432         {
433           wv = xmalloc_widget_value ();
434           wv->type = CASCADE_TYPE;
435           wv->next = NULL;
436           wv->contents = xmalloc_widget_value ();
437           wv->contents->type = TEXT_TYPE;
438           wv->contents->name = (char *) "No menu";
439           wv->contents->next = NULL;
440         }
441       assert (wv && wv->type == CASCADE_TYPE && wv->contents);
442       replace_widget_value_tree (hack_wv, wv->contents);
443       free_popup_widget_value_tree (wv);
444     }
445   else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
446     return;
447   else
448     {
449 #if 0 /* Unused, see comment below. */
450       int any_changes;
451
452       /* #### - this menubar update mechanism is expensively anti-social and
453          the activate-menubar-hook is now mostly obsolete. */
454       any_changes = my_run_hook (Qactivate_menubar_hook, 1);
455
456       /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
457          incremental menus are implemented.  If a subtree of a menu has been
458          updated incrementally (a destructive operation), then that subtree
459          must somehow be wiped.
460
461          It is difficult to undo the destructive operation in lwlib because
462          a pointer back to lisp data needs to be hidden away somewhere.  So
463          that an INCREMENTAL_TYPE widget_value can be recreated...  Hmmmmm. */
464       if (any_changes ||
465           !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
466         set_frame_menubar (f, 1, 0);
467 #else
468       run_hook (Qactivate_menubar_hook);
469       set_frame_menubar (f, 1, 0);
470 #endif
471       DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
472         DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
473         x_focus_timestamp_really_sucks_fix_me_better;
474     }
475 }
476
477 static widget_value *
478 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
479 {
480   widget_value *data;
481
482   if (NILP (menubar))
483     data = 0;
484   else
485     {
486       Lisp_Object old_buffer;
487       int count = specpdl_depth ();
488
489       old_buffer = Fcurrent_buffer ();
490       record_unwind_protect (Fset_buffer, old_buffer);
491       Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
492       data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
493                                                    deep_p, 0);
494       Fset_buffer (old_buffer);
495       unbind_to (count, Qnil);
496     }
497   return data;
498 }
499
500 static int
501 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
502 {
503   widget_value *data;
504   Lisp_Object menubar;
505   int menubar_visible;
506   long id;
507   /* As for the toolbar, the minibuffer does not have its own menubar. */
508   struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
509
510   if (! FRAME_X_P (f))
511     return 0;
512
513   /***** first compute the contents of the menubar *****/
514
515   if (! first_time_p)
516     {
517       /* evaluate `current-menubar' in the buffer of the selected window
518          of the frame in question. */
519       menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
520     }
521   else
522     {
523       /* That's a little tricky the first time since the frame isn't
524          fully initialized yet. */
525       menubar = Fsymbol_value (Qcurrent_menubar);
526     }
527
528   if (NILP (menubar))
529     {
530       menubar = Vblank_menubar;
531       menubar_visible = 0;
532     }
533   else
534     menubar_visible = !NILP (w->menubar_visible_p);
535
536   data = compute_menubar_data (f, menubar, deep_p);
537   if (!data || (!data->next && !data->contents))
538     abort ();
539
540   if (NILP (FRAME_MENUBAR_DATA (f)))
541     {
542       struct popup_data *mdata =
543         alloc_lcrecord_type (struct popup_data, lrecord_popup_data);
544
545       mdata->id = new_lwlib_id ();
546       mdata->last_menubar_buffer = Qnil;
547       mdata->menubar_contents_up_to_date = 0;
548       XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
549     }
550
551   /***** now store into the menubar widget, creating it if necessary *****/
552
553   id = XFRAME_MENUBAR_DATA (f)->id;
554   if (!FRAME_X_MENUBAR_WIDGET (f))
555     {
556       Widget parent = FRAME_X_CONTAINER_WIDGET (f);
557
558       assert (first_time_p);
559
560       /* It's the first time we've mapped the menubar so compute its
561          contents completely once.  This makes sure that the menubar
562          components are created with the right type. */
563       if (!deep_p)
564         {
565           free_popup_widget_value_tree (data);
566           data = compute_menubar_data (f, menubar, 1);
567         }
568
569
570       FRAME_X_MENUBAR_WIDGET (f) =
571         lw_create_widget ("menubar", "menubar", id, data, parent,
572                           0, pre_activate_callback,
573                           popup_selection_callback, 0);
574
575     }
576   else
577     {
578       lw_modify_all_widgets (id, data, deep_p ? True : False);
579     }
580   free_popup_widget_value_tree (data);
581
582   XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
583   XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
584     XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
585   return menubar_visible;
586 }
587
588
589 /* Called from x_create_widgets() to create the inital menubar of a frame
590    before it is mapped, so that the window is mapped with the menubar already
591    there instead of us tacking it on later and thrashing the window after it
592    is visible. */
593 int
594 x_initialize_frame_menubar (struct frame *f)
595 {
596   return set_frame_menubar (f, 1, 1);
597 }
598
599
600 static LWLIB_ID last_popup_menu_selection_callback_id;
601
602 static void
603 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
604                                XtPointer client_data)
605 {
606   last_popup_menu_selection_callback_id = id;
607   popup_selection_callback (widget, id, client_data);
608   /* lw_destroy_all_widgets() will be called from popup_down_callback() */
609 }
610
611 static void
612 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
613 {
614   if (popup_handled_p (id))
615     return;
616   assert (popup_up_p != 0);
617   ungcpro_popup_callbacks (id);
618   popup_up_p--;
619   /* if this isn't called immediately after the selection callback, then
620      there wasn't a menu selection. */
621   if (id != last_popup_menu_selection_callback_id)
622     popup_selection_callback (widget, id, (XtPointer) -1);
623   lw_destroy_all_widgets (id);
624 }
625
626 \f
627 static void
628 make_dummy_xbutton_event (XEvent *dummy,
629                           Widget daddy,
630                           struct Lisp_Event *eev)
631      /* NULL for eev means query pointer */
632 {
633   XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
634
635   btn->type = ButtonPress;
636   btn->serial = 0;
637   btn->send_event = 0;
638   btn->display = XtDisplay (daddy);
639   btn->window = XtWindow (daddy);
640   if (eev)
641     {
642       Position shellx, shelly, framex, framey;
643       Widget shell = XtParent (daddy);
644       Arg al [2];
645       btn->time = eev->timestamp;
646       btn->button = eev->event.button.button;
647       btn->root = RootWindowOfScreen (XtScreen (daddy));
648       btn->subwindow = (Window) NULL;
649       btn->x = eev->event.button.x;
650       btn->y = eev->event.button.y;
651       XtSetArg (al [0], XtNx, &shellx);
652       XtSetArg (al [1], XtNy, &shelly);
653       XtGetValues (shell, al, 2);
654       XtSetArg (al [0], XtNx, &framex);
655       XtSetArg (al [1], XtNy, &framey);
656       XtGetValues (daddy, al, 2);
657       btn->x_root = shellx + framex + btn->x;
658       btn->y_root = shelly + framey + btn->y;;
659       btn->state = ButtonPressMask; /* all buttons pressed */
660     }
661   else
662     {
663       /* CurrentTime is just ZERO, so it's worthless for
664          determining relative click times. */
665       struct device *d = get_device_from_display (XtDisplay (daddy));
666       btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
667       btn->button = 0;
668       XQueryPointer (btn->display, btn->window, &btn->root,
669                      &btn->subwindow, &btn->x_root, &btn->y_root,
670                      &btn->x, &btn->y, &btn->state);
671     }
672 }
673
674 \f
675
676 static void
677 x_update_frame_menubar_internal (struct frame *f)
678 {
679   /* We assume the menubar contents has changed if the global flag is set,
680      or if the current buffer has changed, or if the menubar has never
681      been updated before.
682    */
683   int menubar_contents_changed =
684     (f->menubar_changed
685      || NILP (FRAME_MENUBAR_DATA (f))
686      || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
687               XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
688
689   Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
690   Boolean menubar_will_be_visible = menubar_was_visible;
691   Boolean menubar_visibility_changed;
692
693   if (menubar_contents_changed)
694     menubar_will_be_visible = set_frame_menubar (f, 0, 0);
695
696   menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
697
698   if (!menubar_visibility_changed)
699     return;
700
701   /* Set menubar visibility */
702   (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
703     (FRAME_X_MENUBAR_WIDGET (f));
704
705   MARK_FRAME_SIZE_SLIPPED (f);
706 }
707
708 static void
709 x_update_frame_menubars (struct frame *f)
710 {
711   assert (FRAME_X_P (f));
712
713   x_update_frame_menubar_internal (f);
714
715   /* #### This isn't going to work right now that this function works on
716      a per-frame, not per-device basis.  Guess what?  I don't care. */
717 }
718
719 static void
720 x_free_frame_menubars (struct frame *f)
721 {
722   Widget menubar_widget;
723
724   assert (FRAME_X_P (f));
725
726   menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
727   if (menubar_widget)
728     {
729       LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
730       lw_destroy_all_widgets (id);
731       XFRAME_MENUBAR_DATA (f)->id = 0;
732     }
733 }
734
735 static void
736 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
737 {
738   int menu_id;
739   struct frame *f = selected_frame ();
740   widget_value *data;
741   Widget parent;
742   Widget menu;
743   struct Lisp_Event *eev = NULL;
744   XEvent xev;
745   Lisp_Object frame;
746
747   XSETFRAME (frame, f);
748   CHECK_X_FRAME (frame);
749   parent = FRAME_X_SHELL_WIDGET (f);
750
751   if (!NILP (event))
752     {
753       CHECK_LIVE_EVENT (event);
754       eev= XEVENT (event);
755       if (eev->event_type != button_press_event
756           && eev->event_type != button_release_event)
757         wrong_type_argument (Qmouse_event_p, event);
758     }
759   else if (!NILP (Vthis_command_keys))
760     {
761       /* if an event wasn't passed, use the last event of the event sequence
762          currently being executed, if that event is a mouse event */
763       eev = XEVENT (Vthis_command_keys); /* last event first */
764       if (eev->event_type != button_press_event
765           && eev->event_type != button_release_event)
766         eev = NULL;
767     }
768   make_dummy_xbutton_event (&xev, parent, eev);
769
770   if (SYMBOLP (menu_desc))
771     menu_desc = Fsymbol_value (menu_desc);
772   CHECK_CONS (menu_desc);
773   CHECK_STRING (XCAR (menu_desc));
774   data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
775
776   if (! data) error ("no menu");
777
778   menu_id = new_lwlib_id ();
779   menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
780                            parent, 1, 0,
781                            popup_menu_selection_callback,
782                            popup_menu_down_callback);
783   free_popup_widget_value_tree (data);
784
785   gcpro_popup_callbacks (menu_id);
786
787   /* Setting zmacs-region-stays is necessary here because executing a command
788      from a menu is really a two-command process: the first command (bound to
789      the button-click) simply pops up the menu, and returns.  This causes a
790      sequence of magic-events (destined for the popup-menu widget) to begin.
791      Eventually, a menu item is selected, and a menu-event blip is pushed onto
792      the end of the input stream, which is then executed by the event loop.
793
794      So there are two command-events, with a bunch of magic-events between
795      them.  We don't want the *first* command event to alter the state of the
796      region, so that the region can be available as an argument for the second
797      command.
798    */
799   if (zmacs_regions)
800     zmacs_region_stays = 1;
801
802   popup_up_p++;
803   lw_popup_menu (menu, &xev);
804   /* this speeds up display of pop-up menus */
805   XFlush (XtDisplay (parent));
806 }
807
808 \f
809 void
810 syms_of_menubar_x (void)
811 {
812 }
813
814 void
815 console_type_create_menubar_x (void)
816 {
817   CONSOLE_HAS_METHOD (x, update_frame_menubars);
818   CONSOLE_HAS_METHOD (x, free_frame_menubars);
819   CONSOLE_HAS_METHOD (x, popup_menu);
820 }
821
822 void
823 vars_of_menubar_x (void)
824 {
825   last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
826
827 #if defined (LWLIB_MENUBARS_LUCID)
828   Fprovide (intern ("lucid-menubars"));
829 #elif defined (LWLIB_MENUBARS_MOTIF)
830   Fprovide (intern ("motif-menubars"));
831 #elif defined (LWLIB_MENUBARS_ATHENA)
832   Fprovide (intern ("athena-menubars"));
833 #endif
834 }