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