XEmacs 21.2-b1
[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
337 /* The order in which callbacks are run is funny to say the least.
338    It's sometimes tricky to avoid running a callback twice, and to
339    avoid returning prematurely.  So, this function returns true
340    if the menu's callbacks are no longer gc protected.  So long
341    as we unprotect them before allowing other callbacks to run,
342    everything should be ok.
343
344    The pre_activate_callback() *IS* intentionally called multiple times.
345    If client_data == NULL, then it's being called before the menu is posted.
346    If client_data != NULL, then client_data is a (widget_value *) and
347    client_data->data is a Lisp_Object pointing to a lisp submenu description
348    that must be converted into widget_values.  *client_data is destructively
349    modified.
350
351    #### Stig thinks that there may be a GC problem here due to the
352    fact that pre_activate_callback() is called multiple times, but I
353    think he's wrong.
354
355    */
356
357 static void
358 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
359 {
360   /* This function can GC */
361   struct gcpro gcpro1;
362   struct device *d = get_device_from_display (XtDisplay (widget));
363   struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
364   Lisp_Object rest = Qnil;
365   Lisp_Object frame;
366   int any_changes = 0;
367   int count;
368
369   /* set in lwlib to the time stamp associated with the most recent menu
370      operation */
371   extern Time x_focus_timestamp_really_sucks_fix_me_better;
372
373   if (!f)
374     f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
375   if (!f)
376     return;
377
378   /* make sure f is the selected frame */
379   XSETFRAME (frame, f);
380   Fselect_frame (frame);
381
382   if (client_data)
383     {
384       /* this is an incremental menu construction callback */
385       widget_value *hack_wv = (widget_value *) client_data;
386       Lisp_Object submenu_desc;
387       widget_value *wv;
388
389       assert (hack_wv->type == INCREMENTAL_TYPE);
390       VOID_TO_LISP (submenu_desc, hack_wv->call_data);
391
392       /*
393        * #### Fix the menu code so this isn't necessary.
394        *
395        * Protect against reentering the menu code otherwise we will
396        * crash later when the code gets confused at the state
397        * changes.
398        */
399       count = specpdl_depth ();
400       record_unwind_protect (restore_in_menu_callback,
401                              make_int (in_menu_callback));
402       in_menu_callback = 1;
403       wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
404                                                  1, 0);
405       unbind_to (count, Qnil);
406
407       if (!wv)
408         {
409           wv = xmalloc_widget_value ();
410           wv->type = CASCADE_TYPE;
411           wv->next = NULL;
412           wv->contents = xmalloc_widget_value ();
413           wv->contents->type = TEXT_TYPE;
414           wv->contents->name = (char *) "No menu";
415           wv->contents->next = NULL;
416         }
417       assert (wv && wv->type == CASCADE_TYPE && wv->contents);
418       replace_widget_value_tree (hack_wv, wv->contents);
419       free_popup_widget_value_tree (wv);
420     }
421   else
422     {
423       if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
424         return;
425       /* #### - this menubar update mechanism is expensively anti-social and
426          the activate-menubar-hook is now mostly obsolete. */
427       /* make the activate-menubar-hook be a list of functions, not a single
428          function, just to simplify things. */
429       if (!NILP (Vactivate_menubar_hook) &&
430           (!CONSP (Vactivate_menubar_hook) ||
431            EQ (XCAR (Vactivate_menubar_hook), Qlambda)))
432         Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil);
433
434       GCPRO1 (rest);
435       for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest))
436         if (!EQ (call0 (XCAR (rest)), Qt))
437           any_changes = 1;
438 #if 0
439       /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
440          incremental menus are implemented.  If a subtree of a menu has been
441          updated incrementally (a destructive operation), then that subtree
442          must somehow be wiped.
443
444          It is difficult to undo the destructive operation in lwlib because
445          a pointer back to lisp data needs to be hidden away somewhere.  So
446          that an INCREMENTAL_TYPE widget_value can be recreated...  Hmmmmm. */
447       if (any_changes ||
448           !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
449 #endif
450         set_frame_menubar (f, 1, 0);
451       DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
452         DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
453         x_focus_timestamp_really_sucks_fix_me_better;
454       UNGCPRO;
455     }
456 }
457
458 static widget_value *
459 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
460 {
461   widget_value *data;
462
463   if (NILP (menubar))
464     data = 0;
465   else
466     {
467       Lisp_Object old_buffer;
468       int count = specpdl_depth ();
469
470       old_buffer = Fcurrent_buffer ();
471       record_unwind_protect (Fset_buffer, old_buffer);
472       Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
473       data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
474                                                    deep_p, 0);
475       Fset_buffer (old_buffer);
476       unbind_to (count, Qnil);
477     }
478   return data;
479 }
480
481 static int
482 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
483 {
484   widget_value *data;
485   Lisp_Object menubar;
486   int menubar_visible;
487   long id;
488   /* As for the toolbar, the minibuffer does not have its own menubar. */
489   struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
490
491   if (! FRAME_X_P (f))
492     return 0;
493
494   /***** first compute the contents of the menubar *****/
495
496   if (! first_time_p)
497     {
498       /* evaluate `current-menubar' in the buffer of the selected window
499          of the frame in question. */
500       menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
501     }
502   else
503     {
504       /* That's a little tricky the first time since the frame isn't
505          fully initialized yet. */
506       menubar = Fsymbol_value (Qcurrent_menubar);
507     }
508
509   if (NILP (menubar))
510     {
511       menubar = Vblank_menubar;
512       menubar_visible = 0;
513     }
514   else
515     menubar_visible = !NILP (w->menubar_visible_p);
516
517   data = compute_menubar_data (f, menubar, deep_p);
518   if (!data || (!data->next && !data->contents))
519     abort ();
520
521   if (NILP (FRAME_MENUBAR_DATA (f)))
522     {
523       struct popup_data *mdata =
524         alloc_lcrecord_type (struct popup_data, lrecord_popup_data);
525
526       mdata->id = new_lwlib_id ();
527       mdata->last_menubar_buffer = Qnil;
528       mdata->menubar_contents_up_to_date = 0;
529       XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
530     }
531
532   /***** now store into the menubar widget, creating it if necessary *****/
533
534   id = XFRAME_MENUBAR_DATA (f)->id;
535   if (!FRAME_X_MENUBAR_WIDGET (f))
536     {
537       Widget parent = FRAME_X_CONTAINER_WIDGET (f);
538
539       assert (first_time_p);
540
541       /* It's the first time we've mapped the menubar so compute its
542          contents completely once.  This makes sure that the menubar
543          components are created with the right type. */
544       if (!deep_p)
545         {
546           free_popup_widget_value_tree (data);
547           data = compute_menubar_data (f, menubar, 1);
548         }
549
550
551       FRAME_X_MENUBAR_WIDGET (f) =
552         lw_create_widget ("menubar", "menubar", id, data, parent,
553                           0, pre_activate_callback,
554                           popup_selection_callback, 0);
555
556     }
557   else
558     {
559       lw_modify_all_widgets (id, data, deep_p ? True : False);
560     }
561   free_popup_widget_value_tree (data);
562
563   XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
564   XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
565     XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
566   return menubar_visible;
567 }
568
569
570 /* Called from x_create_widgets() to create the inital menubar of a frame
571    before it is mapped, so that the window is mapped with the menubar already
572    there instead of us tacking it on later and thrashing the window after it
573    is visible. */
574 int
575 x_initialize_frame_menubar (struct frame *f)
576 {
577   return set_frame_menubar (f, 1, 1);
578 }
579
580
581 static LWLIB_ID last_popup_menu_selection_callback_id;
582
583 static void
584 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
585                                XtPointer client_data)
586 {
587   last_popup_menu_selection_callback_id = id;
588   popup_selection_callback (widget, id, client_data);
589   /* lw_destroy_all_widgets() will be called from popup_down_callback() */
590 }
591
592 static void
593 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
594 {
595   if (popup_handled_p (id))
596     return;
597   assert (popup_up_p != 0);
598   ungcpro_popup_callbacks (id);
599   popup_up_p--;
600   /* if this isn't called immediately after the selection callback, then
601      there wasn't a menu selection. */
602   if (id != last_popup_menu_selection_callback_id)
603     popup_selection_callback (widget, id, (XtPointer) -1);
604   lw_destroy_all_widgets (id);
605 }
606
607 \f
608 static void
609 make_dummy_xbutton_event (XEvent *dummy,
610                           Widget daddy,
611                           struct Lisp_Event *eev)
612      /* NULL for eev means query pointer */
613 {
614   XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
615
616   btn->type = ButtonPress;
617   btn->serial = 0;
618   btn->send_event = 0;
619   btn->display = XtDisplay (daddy);
620   btn->window = XtWindow (daddy);
621   if (eev)
622     {
623       Position shellx, shelly, framex, framey;
624       Widget shell = XtParent (daddy);
625       Arg al [2];
626       btn->time = eev->timestamp;
627       btn->button = eev->event.button.button;
628       btn->root = RootWindowOfScreen (XtScreen (daddy));
629       btn->subwindow = (Window) NULL;
630       btn->x = eev->event.button.x;
631       btn->y = eev->event.button.y;
632       XtSetArg (al [0], XtNx, &shellx);
633       XtSetArg (al [1], XtNy, &shelly);
634       XtGetValues (shell, al, 2);
635       XtSetArg (al [0], XtNx, &framex);
636       XtSetArg (al [1], XtNy, &framey);
637       XtGetValues (daddy, al, 2);
638       btn->x_root = shellx + framex + btn->x;
639       btn->y_root = shelly + framey + btn->y;;
640       btn->state = ButtonPressMask; /* all buttons pressed */
641     }
642   else
643     {
644       /* CurrentTime is just ZERO, so it's worthless for
645          determining relative click times. */
646       struct device *d = get_device_from_display (XtDisplay (daddy));
647       btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
648       btn->button = 0;
649       XQueryPointer (btn->display, btn->window, &btn->root,
650                      &btn->subwindow, &btn->x_root, &btn->y_root,
651                      &btn->x, &btn->y, &btn->state);
652     }
653 }
654
655 \f
656
657 static void
658 x_update_frame_menubar_internal (struct frame *f)
659 {
660   /* We assume the menubar contents has changed if the global flag is set,
661      or if the current buffer has changed, or if the menubar has never
662      been updated before.
663    */
664   int menubar_contents_changed =
665     (f->menubar_changed
666      || NILP (FRAME_MENUBAR_DATA (f))
667      || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
668               XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
669
670   Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
671   Boolean menubar_will_be_visible = menubar_was_visible;
672   Boolean menubar_visibility_changed;
673
674   if (menubar_contents_changed)
675     menubar_will_be_visible = set_frame_menubar (f, 0, 0);
676
677   menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
678
679   if (!menubar_visibility_changed)
680     return;
681
682   /* Set menubar visibility */
683   (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
684     (FRAME_X_MENUBAR_WIDGET (f));
685
686   MARK_FRAME_SIZE_SLIPPED (f);
687 }
688
689 static void
690 x_update_frame_menubars (struct frame *f)
691 {
692   assert (FRAME_X_P (f));
693
694   x_update_frame_menubar_internal (f);
695
696   /* #### This isn't going to work right now that this function works on
697      a per-frame, not per-device basis.  Guess what?  I don't care. */
698 }
699
700 static void
701 x_free_frame_menubars (struct frame *f)
702 {
703   Widget menubar_widget;
704
705   assert (FRAME_X_P (f));
706
707   menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
708   if (menubar_widget)
709     {
710       LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
711       lw_destroy_all_widgets (id);
712       XFRAME_MENUBAR_DATA (f)->id = 0;
713     }
714 }
715
716 static void
717 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
718 {
719   int menu_id;
720   struct frame *f = selected_frame ();
721   widget_value *data;
722   Widget parent;
723   Widget menu;
724   struct Lisp_Event *eev = NULL;
725   XEvent xev;
726   Lisp_Object frame;
727
728   XSETFRAME (frame, f);
729   CHECK_X_FRAME (frame);
730   parent = FRAME_X_SHELL_WIDGET (f);
731
732   if (!NILP (event))
733     {
734       CHECK_LIVE_EVENT (event);
735       eev= XEVENT (event);
736       if (eev->event_type != button_press_event
737           && eev->event_type != button_release_event)
738         wrong_type_argument (Qmouse_event_p, event);
739     }
740   else if (!NILP (Vthis_command_keys))
741     {
742       /* if an event wasn't passed, use the last event of the event sequence
743          currently being executed, if that event is a mouse event */
744       eev = XEVENT (Vthis_command_keys); /* last event first */
745       if (eev->event_type != button_press_event
746           && eev->event_type != button_release_event)
747         eev = NULL;
748     }
749   make_dummy_xbutton_event (&xev, parent, eev);
750
751   if (SYMBOLP (menu_desc))
752     menu_desc = Fsymbol_value (menu_desc);
753   CHECK_CONS (menu_desc);
754   CHECK_STRING (XCAR (menu_desc));
755   data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
756
757   if (! data) error ("no menu");
758
759   menu_id = new_lwlib_id ();
760   menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
761                            parent, 1, 0,
762                            popup_menu_selection_callback,
763                            popup_menu_down_callback);
764   free_popup_widget_value_tree (data);
765
766   gcpro_popup_callbacks (menu_id);
767
768   /* Setting zmacs-region-stays is necessary here because executing a command
769      from a menu is really a two-command process: the first command (bound to
770      the button-click) simply pops up the menu, and returns.  This causes a
771      sequence of magic-events (destined for the popup-menu widget) to begin.
772      Eventually, a menu item is selected, and a menu-event blip is pushed onto
773      the end of the input stream, which is then executed by the event loop.
774
775      So there are two command-events, with a bunch of magic-events between
776      them.  We don't want the *first* command event to alter the state of the
777      region, so that the region can be available as an argument for the second
778      command.
779    */
780   if (zmacs_regions)
781     zmacs_region_stays = 1;
782
783   popup_up_p++;
784   lw_popup_menu (menu, &xev);
785   /* this speeds up display of pop-up menus */
786   XFlush (XtDisplay (parent));
787 }
788
789 \f
790 void
791 syms_of_menubar_x (void)
792 {
793 }
794
795 void
796 console_type_create_menubar_x (void)
797 {
798   CONSOLE_HAS_METHOD (x, update_frame_menubars);
799   CONSOLE_HAS_METHOD (x, free_frame_menubars);
800   CONSOLE_HAS_METHOD (x, popup_menu);
801 }
802
803 void
804 vars_of_menubar_x (void)
805 {
806   last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
807
808 #if defined (LWLIB_MENUBARS_LUCID)
809   Fprovide (intern ("lucid-menubars"));
810 #elif defined (LWLIB_MENUBARS_MOTIF)
811   Fprovide (intern ("motif-menubars"));
812 #elif defined (LWLIB_MENUBARS_ATHENA)
813   Fprovide (intern ("athena-menubars"));
814 #endif
815 }