(U-00024532): Use `->denotational' and `->subsumptive'.
[chise/xemacs-chise.git-] / 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    Copyright (C) 2000 Ben Wing.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING.  If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA.  */
22
23 /* Synched up with: Not in FSF. */
24
25 /* This file Mule-ized by Ben Wing, 7-8-00. */
26
27 /* Authorship:
28
29    Created 16-dec-91 by Jamie Zawinski.
30    Menu filters and many other keywords added by Stig for 19.12.
31    Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
32    Menu accelerators c. 1997? by ??.  Moved here from event-stream.c.
33    Other work post-1996 by ??.
34 */
35
36 #include <config.h>
37 #include "lisp.h"
38
39 #include "console-x.h"
40 #include "EmacsFrame.h"
41 #include "gui-x.h"
42 #include "../lwlib/lwlib.h"
43
44 #include "buffer.h"
45 #include "commands.h"           /* zmacs_regions */
46 #include "events.h"
47 #include "frame.h"
48 #include "gui.h"
49 #include "keymap.h"
50 #include "menubar.h"
51 #include "opaque.h"
52 #include "window.h"
53
54 static int set_frame_menubar (struct frame *f,
55                               int deep_p,
56                               int first_time_p);
57
58 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
59 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
60
61 #define MENUBAR_TYPE    0
62 #define SUBMENU_TYPE    1
63 #define POPUP_TYPE      2
64
65 \f
66 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
67
68    menu_item_descriptor_to_widget_value() converts a lisp description of a
69    menubar into a tree of widget_value structures.  It allocates widget_values
70    with malloc_widget_value() and allocates other storage only for the `key'
71    slot.  All other slots are filled with pointers to Lisp_String data.  We
72    allocate a widget_value description of the menu or menubar, and hand it to
73    lwlib, which then makes a copy of it, which it manages internally.  We then
74    immediately free our widget_value tree; it will not be referenced again.
75
76    Incremental menu construction callbacks operate just a bit differently.
77    They allocate widget_values and call replace_widget_value_tree() to tell
78    lwlib to destructively modify the incremental stub (subtree) of its
79    separate widget_value tree.
80
81    This function is highly recursive (it follows the menu trees) and may call
82    eval.  The reason we keep pointers to lisp string data instead of copying
83    it and freeing it later is to avoid the speed penalty that would entail
84    (since this needs to be fast, in the simple cases at least).  (The reason
85    we malloc/free the keys slot is because there's not a lisp string around
86    for us to use in that case.)
87
88    Since we keep pointers to lisp strings, and we call eval, we could lose if
89    GC relocates (or frees) those strings.  It's not easy to gc protect the
90    strings because of the recursive nature of this function, and the fact that
91    it returns a data structure that gets freed later.  So...  we do the
92    sleaziest thing possible and inhibit GC for the duration.  This is probably
93    not a big deal...
94
95    We do not have to worry about the pointers to Lisp_String data after
96    this function successfully finishes.  lwlib copies all such data with
97    strdup().  */
98
99 static widget_value *
100 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
101                                         int menu_type, int deep_p,
102                                         int filter_p,
103                                         int depth)
104 {
105   /* This function cannot GC.
106      It is only called from menu_item_descriptor_to_widget_value, which
107      prohibits GC. */
108   int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
109   int count = specpdl_depth ();
110   int partition_seen = 0;
111   widget_value *wv = xmalloc_widget_value ();
112   Lisp_Object wv_closure = make_opaque_ptr (wv);
113
114   record_unwind_protect (widget_value_unwind, wv_closure);
115
116   if (STRINGP (desc))
117     {
118       Bufbyte *string_chars = XSTRING_DATA (desc);
119       wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
120                   TEXT_TYPE);
121       if (wv->type == SEPARATOR_TYPE)
122         {
123           wv->value = menu_separator_style_and_to_external (string_chars);
124         }
125       else
126         {
127           LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding);
128           wv->enabled = 1;
129           /* dverna Dec. 98: command_builder_operate_menu_accelerator will
130              manipulate the accel as a Lisp_Object if the widget has a name.
131              Since simple labels have a name, but no accel, we *must* set it
132              to nil */
133           wv->accel = LISP_TO_VOID (Qnil);
134         }
135     }
136   else if (VECTORP (desc))
137     {
138       Lisp_Object gui_item = gui_parse_item_keywords (desc);
139       if (!button_item_to_widget_value (Qmenubar,
140                                         gui_item, wv, 1,
141                                         (menu_type == MENUBAR_TYPE
142                                          && depth <= 1), 1, 1))
143         {
144           /* :included form was nil */
145           wv = NULL;
146           goto menu_item_done;
147         }
148     }
149   else if (CONSP (desc))
150     {
151       Lisp_Object incremental_data = desc;
152       widget_value *prev = 0;
153
154       if (STRINGP (XCAR (desc)))
155         {
156           Lisp_Object key, val;
157           Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
158           Lisp_Object active_p = Qt;
159           Lisp_Object accel;
160           int included_spec = 0;
161           int active_spec = 0;
162           wv->type = CASCADE_TYPE;
163           wv->enabled = 1;
164           wv->name = add_accel_and_to_external (XCAR (desc));
165
166           accel = gui_name_accelerator (XCAR (desc));
167           wv->accel = LISP_TO_VOID (accel);
168
169           desc = Fcdr (desc);
170
171           while (key = Fcar (desc), KEYWORDP (key))
172             {
173               Lisp_Object cascade = desc;
174               desc = Fcdr (desc);
175               if (NILP (desc))
176                 syntax_error ("Keyword in menu lacks a value", cascade);
177               val = Fcar (desc);
178               desc = Fcdr (desc);
179               if (EQ (key, Q_included))
180                 include_p = val, included_spec = 1;
181               else if (EQ (key, Q_config))
182                 config_tag = val;
183               else if (EQ (key, Q_filter))
184                 hook_fn = val;
185               else if (EQ (key, Q_active))
186                 active_p = val, active_spec = 1;
187               else if (EQ (key, Q_accelerator))
188                 {
189                   if ( SYMBOLP (val)
190                        || CHARP (val))
191                     wv->accel = LISP_TO_VOID (val);
192                   else
193                     syntax_error ("bad keyboard accelerator", val);
194                 }
195               else if (EQ (key, Q_label))
196                 {
197                   /* implement in 21.2 */
198                 }
199               else
200                 syntax_error ("Unknown menu cascade keyword", cascade);
201             }
202
203           if ((!NILP (config_tag)
204                && NILP (Fmemq (config_tag, Vmenubar_configuration)))
205               || (included_spec && NILP (Feval (include_p))))
206             {
207               wv = NULL;
208               goto menu_item_done;
209             }
210
211           if (active_spec)
212             active_p = Feval (active_p);
213
214           if (!NILP (hook_fn) && !NILP (active_p))
215             {
216 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
217               if (filter_p || depth == 0)
218                 {
219 #endif
220                   desc = call1_trapping_errors ("Error in menubar filter",
221                                                 hook_fn, desc);
222                   if (UNBOUNDP (desc))
223                     desc = Qnil;
224 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
225                 }
226               else
227                 {
228                   widget_value *incr_wv = xmalloc_widget_value ();
229                   wv->contents = incr_wv;
230                   incr_wv->type = INCREMENTAL_TYPE;
231                   incr_wv->enabled = 1;
232                   incr_wv->name = wv->name;
233                   incr_wv->name = xstrdup (wv->name);
234                   /* This is automatically GC protected through
235                      the call to lw_map_widget_values(); no need
236                      to worry. */
237                   incr_wv->call_data = LISP_TO_VOID (incremental_data);
238                   goto menu_item_done;
239                 }
240 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
241             }
242           if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
243             {
244               /* Simply prepend three more widget values to the contents of
245                  the menu: a label, and two separators (to get a double
246                  line). */
247               widget_value *title_wv = xmalloc_widget_value ();
248               widget_value *sep_wv = xmalloc_widget_value ();
249               title_wv->type = TEXT_TYPE;
250               title_wv->name = xstrdup (wv->name);
251               title_wv->enabled = 1;
252               title_wv->next = sep_wv;
253               sep_wv->type = SEPARATOR_TYPE;
254               sep_wv->value = menu_separator_style_and_to_external ((Bufbyte *) "==");
255               sep_wv->next = 0;
256
257               wv->contents = title_wv;
258               prev = sep_wv;
259             }
260           wv->enabled = ! NILP (active_p);
261           if (deep_p && !wv->enabled  && !NILP (desc))
262             {
263               widget_value *dummy;
264               /* Add a fake entry so the menus show up */
265               wv->contents = dummy = xmalloc_widget_value ();
266               dummy->name = xstrdup ("(inactive)");
267               dummy->accel = LISP_TO_VOID (Qnil);
268               dummy->enabled = 0;
269               dummy->selected = 0;
270               dummy->value = NULL;
271               dummy->type = BUTTON_TYPE;
272               dummy->call_data = NULL;
273               dummy->next = NULL;
274
275               goto menu_item_done;
276             }
277
278         }
279       else if (menubar_root_p)
280         {
281           wv->name = xstrdup ("menubar");
282           wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
283                                       this is ignored anyway...  */
284         }
285       else
286         {
287           syntax_error ("Menu name (first element) must be a string", desc);
288         }
289
290       if (deep_p || menubar_root_p)
291         {
292           widget_value *next;
293           for (; !NILP (desc); desc = Fcdr (desc))
294             {
295               Lisp_Object child = Fcar (desc);
296               if (menubar_root_p && NILP (child))       /* the partition */
297                 {
298                   if (partition_seen)
299                     syntax_error
300                       ("More than one partition (nil) in menubar description",
301                        desc);
302                   partition_seen = 1;
303                   next = xmalloc_widget_value ();
304                   next->type = PUSHRIGHT_TYPE;
305                 }
306               else
307                 {
308                   next = menu_item_descriptor_to_widget_value_1
309                     (child, menu_type, deep_p, filter_p, depth + 1);
310                 }
311               if (! next)
312                 continue;
313               else if (prev)
314                 prev->next = next;
315               else
316                 wv->contents = next;
317               prev = next;
318             }
319         }
320       if (deep_p && !wv->contents)
321         wv = NULL;
322     }
323   else if (NILP (desc))
324     syntax_error ("nil may not appear in menu descriptions", desc);
325   else
326     syntax_error ("Unrecognized menu descriptor", desc);
327
328  menu_item_done:
329
330   if (wv)
331     {
332       /* Completed normally.  Clear out the object that widget_value_unwind()
333          will be called with to tell it not to free the wv (as we are
334          returning it.) */
335       set_opaque_ptr (wv_closure, 0);
336     }
337
338   unbind_to (count, Qnil);
339   return wv;
340 }
341
342 static widget_value *
343 menu_item_descriptor_to_widget_value (Lisp_Object desc,
344                                       int menu_type, /* if this is a menubar,
345                                                         popup or sub menu */
346                                       int deep_p,    /*  */
347                                       int filter_p)  /* if :filter forms
348                                                         should run now */
349 {
350   widget_value *wv;
351   int count = specpdl_depth ();
352   record_unwind_protect (restore_gc_inhibit,
353                          make_int (gc_currently_forbidden));
354   gc_currently_forbidden = 1;
355   /* Can't GC! */
356   wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
357                                                filter_p, 0);
358   unbind_to (count, Qnil);
359   return wv;
360 }
361
362
363 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
364 int in_menu_callback;
365
366 static Lisp_Object
367 restore_in_menu_callback (Lisp_Object val)
368 {
369   in_menu_callback = XINT (val);
370   return Qnil;
371 }
372 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
373
374 #if 0
375 /* #### Sort of a hack needed to process Vactivate_menubar_hook
376    correctly wrt buffer-local values.  A correct solution would
377    involve adding a callback mechanism to run_hook().  This function
378    is currently unused.  */
379 static int
380 my_run_hook (Lisp_Object hooksym, int allow_global_p)
381 {
382   /* This function can GC */
383   Lisp_Object tail;
384   Lisp_Object value = Fsymbol_value (hooksym);
385   int changes = 0;
386
387   if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
388     return !EQ (call0 (value), Qt);
389
390   EXTERNAL_LIST_LOOP (tail, value)
391     {
392       if (allow_global_p && EQ (XCAR (tail), Qt))
393         changes |= my_run_hook (Fdefault_value (hooksym), 0);
394       if (!EQ (call0 (XCAR (tail)), Qt))
395         changes = 1;
396     }
397   return changes;
398 }
399 #endif
400
401
402 /* The order in which callbacks are run is funny to say the least.
403    It's sometimes tricky to avoid running a callback twice, and to
404    avoid returning prematurely.  So, this function returns true
405    if the menu's callbacks are no longer gc protected.  So long
406    as we unprotect them before allowing other callbacks to run,
407    everything should be ok.
408
409    The pre_activate_callback() *IS* intentionally called multiple times.
410    If client_data == NULL, then it's being called before the menu is posted.
411    If client_data != NULL, then client_data is a (widget_value *) and
412    client_data->data is a Lisp_Object pointing to a lisp submenu description
413    that must be converted into widget_values.  *client_data is destructively
414    modified.
415
416    #### Stig thinks that there may be a GC problem here due to the
417    fact that pre_activate_callback() is called multiple times, but I
418    think he's wrong.
419
420    */
421
422 static void
423 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
424 {
425   /* This function can GC */
426   struct device *d = get_device_from_display (XtDisplay (widget));
427   struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
428   Lisp_Object frame;
429   int count;
430
431   /* set in lwlib to the time stamp associated with the most recent menu
432      operation */
433   extern Time x_focus_timestamp_really_sucks_fix_me_better;
434
435   if (!f)
436     f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
437   if (!f)
438     return;
439
440   /* make sure f is the selected frame */
441   XSETFRAME (frame, f);
442   Fselect_frame (frame);
443
444   if (client_data)
445     {
446       /* this is an incremental menu construction callback */
447       widget_value *hack_wv = (widget_value *) client_data;
448       Lisp_Object submenu_desc;
449       widget_value *wv;
450
451       assert (hack_wv->type == INCREMENTAL_TYPE);
452       VOID_TO_LISP (submenu_desc, hack_wv->call_data);
453
454       /*
455        * #### Fix the menu code so this isn't necessary.
456        *
457        * Protect against reentering the menu code otherwise we will
458        * crash later when the code gets confused at the state
459        * changes.
460        */
461       count = specpdl_depth ();
462       record_unwind_protect (restore_in_menu_callback,
463                              make_int (in_menu_callback));
464       in_menu_callback = 1;
465       wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
466                                                  1, 0);
467       unbind_to (count, Qnil);
468
469       if (!wv)
470         {
471           wv = xmalloc_widget_value ();
472           wv->type = CASCADE_TYPE;
473           wv->next = NULL;
474           wv->accel = LISP_TO_VOID (Qnil);
475           wv->contents = xmalloc_widget_value ();
476           wv->contents->type = TEXT_TYPE;
477           wv->contents->name = xstrdup ("No menu");
478           wv->contents->next = NULL;
479           wv->contents->accel = LISP_TO_VOID (Qnil);
480         }
481       assert (wv && wv->type == CASCADE_TYPE && wv->contents);
482       replace_widget_value_tree (hack_wv, wv->contents);
483       free_popup_widget_value_tree (wv);
484     }
485   else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
486     return;
487   else
488     {
489 #if 0 /* Unused, see comment below. */
490       int any_changes;
491
492       /* #### - this menubar update mechanism is expensively anti-social and
493          the activate-menubar-hook is now mostly obsolete. */
494       any_changes = my_run_hook (Qactivate_menubar_hook, 1);
495
496       /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
497          incremental menus are implemented.  If a subtree of a menu has been
498          updated incrementally (a destructive operation), then that subtree
499          must somehow be wiped.
500
501          It is difficult to undo the destructive operation in lwlib because
502          a pointer back to lisp data needs to be hidden away somewhere.  So
503          that an INCREMENTAL_TYPE widget_value can be recreated...  Hmmmmm. */
504       if (any_changes ||
505           !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
506         set_frame_menubar (f, 1, 0);
507 #else
508       run_hook (Qactivate_menubar_hook);
509       set_frame_menubar (f, 1, 0);
510 #endif
511       DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
512         DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
513         x_focus_timestamp_really_sucks_fix_me_better;
514     }
515 }
516
517 static widget_value *
518 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
519 {
520   if (NILP (menubar))
521     return 0;
522   else
523     {
524       widget_value *data;
525       int count = specpdl_depth ();
526
527       record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
528       Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
529       data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
530                                                    deep_p, 0);
531       unbind_to (count, Qnil);
532
533       return data;
534     }
535 }
536
537 static int
538 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
539 {
540   widget_value *data;
541   Lisp_Object menubar;
542   int menubar_visible;
543   long id;
544   /* As with the toolbar, the minibuffer does not have its own menubar. */
545   struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
546
547   if (! FRAME_X_P (f))
548     return 0;
549
550   /***** first compute the contents of the menubar *****/
551
552   if (! first_time_p)
553     {
554       /* evaluate `current-menubar' in the buffer of the selected window
555          of the frame in question. */
556       menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
557     }
558   else
559     {
560       /* That's a little tricky the first time since the frame isn't
561          fully initialized yet. */
562       menubar = Fsymbol_value (Qcurrent_menubar);
563     }
564
565   if (NILP (menubar))
566     {
567       menubar = Vblank_menubar;
568       menubar_visible = 0;
569     }
570   else
571     menubar_visible = !NILP (w->menubar_visible_p);
572
573   data = compute_menubar_data (f, menubar, deep_p);
574   if (!data || (!data->next && !data->contents))
575     ABORT ();
576
577   if (NILP (FRAME_MENUBAR_DATA (f)))
578     {
579       struct popup_data *mdata =
580         alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
581
582       mdata->id = new_lwlib_id ();
583       mdata->last_menubar_buffer = Qnil;
584       mdata->menubar_contents_up_to_date = 0;
585       XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
586     }
587
588   /***** now store into the menubar widget, creating it if necessary *****/
589
590   id = XFRAME_MENUBAR_DATA (f)->id;
591   if (!FRAME_X_MENUBAR_WIDGET (f))
592     {
593       Widget parent = FRAME_X_CONTAINER_WIDGET (f);
594
595       assert (first_time_p);
596
597       /* It's the first time we've mapped the menubar so compute its
598          contents completely once.  This makes sure that the menubar
599          components are created with the right type. */
600       if (!deep_p)
601         {
602           free_popup_widget_value_tree (data);
603           data = compute_menubar_data (f, menubar, 1);
604         }
605
606
607       FRAME_X_MENUBAR_WIDGET (f) =
608         lw_create_widget ("menubar", "menubar", id, data, parent,
609                           0, pre_activate_callback,
610                           popup_selection_callback, 0);
611
612     }
613   else
614     {
615       lw_modify_all_widgets (id, data, deep_p ? True : False);
616     }
617   free_popup_widget_value_tree (data);
618
619   XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
620   XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
621     XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
622   return menubar_visible;
623 }
624
625
626 /* Called from x_create_widgets() to create the initial menubar of a frame
627    before it is mapped, so that the window is mapped with the menubar already
628    there instead of us tacking it on later and thrashing the window after it
629    is visible. */
630 int
631 x_initialize_frame_menubar (struct frame *f)
632 {
633   return set_frame_menubar (f, 1, 1);
634 }
635
636
637 static LWLIB_ID last_popup_menu_selection_callback_id;
638
639 static void
640 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
641                                XtPointer client_data)
642 {
643   last_popup_menu_selection_callback_id = id;
644   popup_selection_callback (widget, id, client_data);
645   /* lw_destroy_all_widgets() will be called from popup_down_callback() */
646 }
647
648 static void
649 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
650 {
651   if (popup_handled_p (id))
652     return;
653   assert (popup_up_p != 0);
654   ungcpro_popup_callbacks (id);
655   popup_up_p--;
656   /* if this isn't called immediately after the selection callback, then
657      there wasn't a menu selection. */
658   if (id != last_popup_menu_selection_callback_id)
659     popup_selection_callback (widget, id, (XtPointer) -1);
660   lw_destroy_all_widgets (id);
661 }
662
663 \f
664 static void
665 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
666      /* NULL for eev means query pointer */
667 {
668   XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
669
670   btn->type = ButtonPress;
671   btn->serial = 0;
672   btn->send_event = 0;
673   btn->display = XtDisplay (daddy);
674   btn->window = XtWindow (daddy);
675   if (eev)
676     {
677       Position shellx, shelly, framex, framey;
678       Arg al [2];
679       btn->time = eev->timestamp;
680       btn->button = eev->event.button.button;
681       btn->root = RootWindowOfScreen (XtScreen (daddy));
682       btn->subwindow = (Window) NULL;
683       btn->x = eev->event.button.x;
684       btn->y = eev->event.button.y;
685       shellx = shelly = 0;
686 #ifndef HAVE_WMCOMMAND
687       {
688         Widget shell = XtParent (daddy);
689
690         XtSetArg (al [0], XtNx, &shellx);
691         XtSetArg (al [1], XtNy, &shelly);
692         XtGetValues (shell, al, 2);
693       }
694 #endif
695       XtSetArg (al [0], XtNx, &framex);
696       XtSetArg (al [1], XtNy, &framey);
697       XtGetValues (daddy, al, 2);
698       btn->x_root = shellx + framex + btn->x;
699       btn->y_root = shelly + framey + btn->y;
700       btn->state = ButtonPressMask; /* all buttons pressed */
701     }
702   else
703     {
704       /* CurrentTime is just ZERO, so it's worthless for
705          determining relative click times. */
706       struct device *d = get_device_from_display (XtDisplay (daddy));
707       btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
708       btn->button = 0;
709       XQueryPointer (btn->display, btn->window, &btn->root,
710                      &btn->subwindow, &btn->x_root, &btn->y_root,
711                      &btn->x, &btn->y, &btn->state);
712     }
713 }
714
715 \f
716
717 static void
718 x_update_frame_menubar_internal (struct frame *f)
719 {
720   /* We assume the menubar contents has changed if the global flag is set,
721      or if the current buffer has changed, or if the menubar has never
722      been updated before.
723    */
724   int menubar_contents_changed =
725     (f->menubar_changed
726      || NILP (FRAME_MENUBAR_DATA (f))
727      || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
728               XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
729
730   Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
731   Boolean menubar_will_be_visible = menubar_was_visible;
732   Boolean menubar_visibility_changed;
733
734   if (menubar_contents_changed)
735     menubar_will_be_visible = set_frame_menubar (f, 0, 0);
736
737   menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
738
739   if (!menubar_visibility_changed)
740     return;
741
742   /* Set menubar visibility */
743   (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
744     (FRAME_X_MENUBAR_WIDGET (f));
745
746   MARK_FRAME_SIZE_SLIPPED (f);
747 }
748
749 static void
750 x_update_frame_menubars (struct frame *f)
751 {
752   assert (FRAME_X_P (f));
753
754   x_update_frame_menubar_internal (f);
755
756   /* #### This isn't going to work right now that this function works on
757      a per-frame, not per-device basis.  Guess what?  I don't care. */
758 }
759
760 static void
761 x_free_frame_menubars (struct frame *f)
762 {
763   Widget menubar_widget;
764
765   assert (FRAME_X_P (f));
766
767   menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
768   if (menubar_widget)
769     {
770       LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
771       lw_destroy_all_widgets (id);
772       XFRAME_MENUBAR_DATA (f)->id = 0;
773     }
774 }
775
776 static void
777 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
778 {
779   int menu_id;
780   struct frame *f = selected_frame ();
781   widget_value *data;
782   Widget parent;
783   Widget menu;
784   Lisp_Event *eev = NULL;
785   XEvent xev;
786   Lisp_Object frame;
787
788   XSETFRAME (frame, f);
789   CHECK_X_FRAME (frame);
790   parent = FRAME_X_SHELL_WIDGET (f);
791
792   if (!NILP (event))
793     {
794       CHECK_LIVE_EVENT (event);
795       eev= XEVENT (event);
796       if (eev->event_type != button_press_event
797           && eev->event_type != button_release_event)
798         wrong_type_argument (Qmouse_event_p, event);
799     }
800   else if (!NILP (Vthis_command_keys))
801     {
802       /* if an event wasn't passed, use the last event of the event sequence
803          currently being executed, if that event is a mouse event */
804       eev = XEVENT (Vthis_command_keys); /* last event first */
805       if (eev->event_type != button_press_event
806           && eev->event_type != button_release_event)
807         eev = NULL;
808     }
809   make_dummy_xbutton_event (&xev, parent, eev);
810
811   if (SYMBOLP (menu_desc))
812     menu_desc = Fsymbol_value (menu_desc);
813   CHECK_CONS (menu_desc);
814   CHECK_STRING (XCAR (menu_desc));
815   data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
816
817   if (! data) error ("no menu");
818
819   menu_id = new_lwlib_id ();
820   menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
821                            parent, 1, 0,
822                            popup_menu_selection_callback,
823                            popup_menu_down_callback);
824   free_popup_widget_value_tree (data);
825
826   gcpro_popup_callbacks (menu_id);
827
828   /* Setting zmacs-region-stays is necessary here because executing a command
829      from a menu is really a two-command process: the first command (bound to
830      the button-click) simply pops up the menu, and returns.  This causes a
831      sequence of magic-events (destined for the popup-menu widget) to begin.
832      Eventually, a menu item is selected, and a menu-event blip is pushed onto
833      the end of the input stream, which is then executed by the event loop.
834
835      So there are two command-events, with a bunch of magic-events between
836      them.  We don't want the *first* command event to alter the state of the
837      region, so that the region can be available as an argument for the second
838      command.
839   */
840   if (zmacs_regions)
841     zmacs_region_stays = 1;
842
843   popup_up_p++;
844   lw_popup_menu (menu, &xev);
845   /* this speeds up display of pop-up menus */
846   XFlush (XtDisplay (parent));
847 }
848
849 \f
850
851 #if defined(LWLIB_MENUBARS_LUCID)
852 static void
853 menu_move_up (void)
854 {
855   widget_value *current = lw_get_entries (False);
856   widget_value *entries = lw_get_entries (True);
857   widget_value *prev    = NULL;
858
859   while (entries != current)
860     {
861       if (entries->name /*&& entries->enabled*/) prev = entries;
862       entries = entries->next;
863       assert (entries);
864     }
865
866   if (!prev)
867     /* move to last item */
868     {
869       while (entries->next)
870         {
871           if (entries->name /*&& entries->enabled*/) prev = entries;
872           entries = entries->next;
873         }
874       if (prev)
875         {
876           if (entries->name /*&& entries->enabled*/)
877             prev = entries;
878         }
879       else
880         {
881           /* no selectable items in this menu, pop up to previous level */
882           lw_pop_menu ();
883           return;
884         }
885     }
886   lw_set_item (prev);
887 }
888
889 static void
890 menu_move_down (void)
891 {
892   widget_value *current = lw_get_entries (False);
893   widget_value *new = current;
894
895   while (new->next)
896     {
897       new = new->next;
898       if (new->name /*&& new->enabled*/) break;
899     }
900
901   if (new==current||!(new->name/*||new->enabled*/))
902     {
903       new = lw_get_entries (True);
904       while (new!=current)
905         {
906           if (new->name /*&& new->enabled*/) break;
907           new = new->next;
908         }
909       if (new==current&&!(new->name /*|| new->enabled*/))
910         {
911           lw_pop_menu ();
912           return;
913         }
914     }
915
916   lw_set_item (new);
917 }
918
919 static void
920 menu_move_left (void)
921 {
922   int level = lw_menu_level ();
923   int l = level;
924   widget_value *current;
925
926   while (level-- >= 3)
927     lw_pop_menu ();
928
929   menu_move_up ();
930   current = lw_get_entries (False);
931   if (l > 2 && current->contents)
932     lw_push_menu (current->contents);
933 }
934
935 static void
936 menu_move_right (void)
937 {
938   int level = lw_menu_level ();
939   int l = level;
940   widget_value *current;
941
942   while (level-- >= 3)
943     lw_pop_menu ();
944
945   menu_move_down ();
946   current = lw_get_entries (False);
947   if (l > 2 && current->contents)
948     lw_push_menu (current->contents);
949 }
950
951 static void
952 menu_select_item (widget_value *val)
953 {
954   if (val == NULL)
955     val = lw_get_entries (False);
956
957   /* is match a submenu? */
958
959   if (val->contents)
960     {
961       /* enter the submenu */
962
963       lw_set_item (val);
964       lw_push_menu (val->contents);
965     }
966   else
967     {
968       /* Execute the menu entry by calling the menu's `select'
969          callback function
970       */
971       lw_kill_menus (val);
972     }
973 }
974
975 Lisp_Object
976 command_builder_operate_menu_accelerator (struct command_builder *builder)
977 {
978   /* this function can GC */
979
980   struct console *con = XCONSOLE (Vselected_console);
981   Lisp_Object evee = builder->most_current_event;
982   Lisp_Object binding;
983   widget_value *entries;
984
985   extern int lw_menu_accelerate; /* lwlib.c */
986
987 #if 0
988   {
989     int i;
990     Lisp_Object t;
991     char buf[50];
992
993     t = builder->current_events;
994     i = 0;
995     while (!NILP (t))
996       {
997         i++;
998         sprintf (buf,"OPERATE (%d): ",i);
999         write_c_string (buf, Qexternal_debugging_output);
1000         print_internal (t, Qexternal_debugging_output, 1);
1001         write_c_string ("\n", Qexternal_debugging_output);
1002         t = XEVENT_NEXT (t);
1003       }
1004   }
1005 #endif /* 0 */
1006
1007   /* menu accelerator keys don't go into keyboard macros */
1008   if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1009     con->kbd_macro_ptr = con->kbd_macro_end;
1010
1011   /* don't echo menu accelerator keys */
1012   /*reset_key_echo (builder, 1);*/
1013
1014   if (!lw_menu_accelerate)
1015     {
1016       /* `convert' mouse display to keyboard display
1017          by entering the open submenu
1018       */
1019       entries = lw_get_entries (False);
1020       if (entries->contents)
1021         {
1022           lw_push_menu (entries->contents);
1023           lw_display_menu (CurrentTime);
1024         }
1025     }
1026
1027   /* compare event to the current menu accelerators */
1028
1029   entries=lw_get_entries (True);
1030
1031   while (entries)
1032     {
1033       Lisp_Object accel;
1034       VOID_TO_LISP (accel, entries->accel);
1035       if (entries->name && !NILP (accel))
1036         {
1037           if (event_matches_key_specifier_p (XEVENT (evee), accel))
1038             {
1039               /* a match! */
1040
1041               menu_select_item (entries);
1042
1043               if (lw_menu_active) lw_display_menu (CurrentTime);
1044
1045               reset_this_command_keys (Vselected_console, 1);
1046               /*reset_command_builder_event_chain (builder);*/
1047               return Vmenu_accelerator_map;
1048             }
1049         }
1050       entries = entries->next;
1051     }
1052
1053   /* try to look up event in menu-accelerator-map */
1054
1055   binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
1056
1057   if (NILP (binding))
1058     {
1059       /* beep at user for undefined key */
1060       return Qnil;
1061     }
1062   else
1063     {
1064       if (EQ (binding, Qmenu_quit))
1065         {
1066           /* turn off menus and set quit flag */
1067           lw_kill_menus (NULL);
1068           Vquit_flag = Qt;
1069         }
1070       else if (EQ (binding, Qmenu_up))
1071         {
1072           int level = lw_menu_level ();
1073           if (level > 2)
1074             menu_move_up ();
1075         }
1076       else if (EQ (binding, Qmenu_down))
1077         {
1078           int level = lw_menu_level ();
1079           if (level > 2)
1080             menu_move_down ();
1081           else
1082             menu_select_item (NULL);
1083         }
1084       else if (EQ (binding, Qmenu_left))
1085         {
1086           int level = lw_menu_level ();
1087           if (level > 3)
1088             {
1089               lw_pop_menu ();
1090               lw_display_menu (CurrentTime);
1091             }
1092           else
1093             menu_move_left ();
1094         }
1095       else if (EQ (binding, Qmenu_right))
1096         {
1097           int level = lw_menu_level ();
1098           if (level > 2 &&
1099               lw_get_entries (False)->contents)
1100             {
1101               widget_value *current = lw_get_entries (False);
1102               if (current->contents)
1103                 menu_select_item (NULL);
1104             }
1105           else
1106             menu_move_right ();
1107         }
1108       else if (EQ (binding, Qmenu_select))
1109         menu_select_item (NULL);
1110       else if (EQ (binding, Qmenu_escape))
1111         {
1112           int level = lw_menu_level ();
1113
1114           if (level > 2)
1115             {
1116               lw_pop_menu ();
1117               lw_display_menu (CurrentTime);
1118             }
1119           else
1120             {
1121               /* turn off menus quietly */
1122               lw_kill_menus (NULL);
1123             }
1124         }
1125       else if (KEYMAPP (binding))
1126         {
1127           /* prefix key */
1128           reset_this_command_keys (Vselected_console, 1);
1129           /*reset_command_builder_event_chain (builder);*/
1130           return binding;
1131         }
1132       else
1133         {
1134           /* turn off menus and execute binding */
1135           lw_kill_menus (NULL);
1136           reset_this_command_keys (Vselected_console, 1);
1137           /*reset_command_builder_event_chain (builder);*/
1138           return binding;
1139         }
1140     }
1141
1142   if (lw_menu_active) lw_display_menu (CurrentTime);
1143
1144   reset_this_command_keys (Vselected_console, 1);
1145   /*reset_command_builder_event_chain (builder);*/
1146
1147   return Vmenu_accelerator_map;
1148 }
1149
1150 static Lisp_Object
1151 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
1152 {
1153   Vmenu_accelerator_prefix    = Qnil;
1154   Vmenu_accelerator_modifiers = Qnil;
1155   Vmenu_accelerator_enabled   = Qnil;
1156   if (!NILP (errordata))
1157     {
1158       Lisp_Object args[2];
1159
1160       args[0] = build_string ("Error in menu accelerators (setting to nil)");
1161       /* #### This should call
1162          (with-output-to-string (display-error errordata))
1163          but that stuff is all in Lisp currently. */
1164       args[1] = errordata;
1165       warn_when_safe_lispobj
1166         (Qerror, Qwarning,
1167          emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
1168                                    Qnil, -1, 2, args));
1169     }
1170
1171   return Qnil;
1172 }
1173
1174 static Lisp_Object
1175 menu_accelerator_safe_compare (Lisp_Object event0)
1176 {
1177   if (CONSP (Vmenu_accelerator_prefix))
1178     {
1179       Lisp_Object t;
1180       t=Vmenu_accelerator_prefix;
1181       while (!NILP (t)
1182              && !NILP (event0)
1183              && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
1184         {
1185           t = Fcdr (t);
1186           event0 = XEVENT_NEXT (event0);
1187         }
1188       if (!NILP (t))
1189         return Qnil;
1190     }
1191   else if (NILP (event0))
1192     return Qnil;
1193   else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
1194     event0 = XEVENT_NEXT (event0);
1195   else
1196     return Qnil;
1197   return event0;
1198 }
1199
1200 static Lisp_Object
1201 menu_accelerator_safe_mod_compare (Lisp_Object cons)
1202 {
1203   return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
1204           ? Qt
1205           : Qnil);
1206 }
1207
1208 Lisp_Object
1209 command_builder_find_menu_accelerator (struct command_builder *builder)
1210 {
1211   /* this function can GC */
1212   Lisp_Object event0 = builder->current_events;
1213   struct console *con = XCONSOLE (Vselected_console);
1214   struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1215   Widget menubar_widget;
1216
1217   /* compare entries in event0 against the menu prefix */
1218
1219   if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
1220       XEVENT (event0)->event_type != key_press_event)
1221     return Qnil;
1222
1223   if (!NILP (Vmenu_accelerator_prefix))
1224     {
1225       event0 = condition_case_1 (Qerror,
1226                                  menu_accelerator_safe_compare,
1227                                  event0,
1228                                  menu_accelerator_junk_on_error,
1229                                  Qnil);
1230     }
1231
1232   if (NILP (event0))
1233     return Qnil;
1234
1235   menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
1236   if (menubar_widget
1237       && CONSP (Vmenu_accelerator_modifiers))
1238     {
1239       Lisp_Object fake = Qnil;
1240       Lisp_Object last = Qnil;
1241       struct gcpro gcpro1;
1242       Lisp_Object matchp;
1243
1244       widget_value *val;
1245       LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
1246
1247       val = lw_get_all_values (id);
1248       if (val)
1249         {
1250           val = val->contents;
1251
1252           fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
1253           last = fake;
1254
1255           while (!NILP (Fcdr (last)))
1256             last = Fcdr (last);
1257
1258           Fsetcdr (last, Fcons (Qnil, Qnil));
1259           last = Fcdr (last);
1260         }
1261
1262       fake = Fcons (Qnil, fake);
1263
1264       GCPRO1 (fake);
1265
1266       while (val)
1267         {
1268           Lisp_Object accel;
1269           VOID_TO_LISP (accel, val->accel);
1270           if (val->name && !NILP (accel))
1271             {
1272               Fsetcar (last, accel);
1273               Fsetcar (fake, event0);
1274               matchp = condition_case_1 (Qerror,
1275                                          menu_accelerator_safe_mod_compare,
1276                                          fake,
1277                                          menu_accelerator_junk_on_error,
1278                                          Qnil);
1279               if (!NILP (matchp))
1280                 {
1281                   /* we found one! */
1282
1283                   lw_set_menu (menubar_widget, val);
1284                   /* yah - yet another hack.
1285                      pretend emacs timestamp is the same as an X timestamp,
1286                      which for the moment it is.  (read events.h)
1287                      */
1288                   lw_map_menu (XEVENT (event0)->timestamp);
1289
1290                   if (val->contents)
1291                     lw_push_menu (val->contents);
1292
1293                   lw_display_menu (CurrentTime);
1294
1295                   /* menu accelerator keys don't go into keyboard macros */
1296                   if (!NILP (con->defining_kbd_macro)
1297                       && NILP (Vexecuting_macro))
1298                     con->kbd_macro_ptr = con->kbd_macro_end;
1299
1300                   /* don't echo menu accelerator keys */
1301                   /*reset_key_echo (builder, 1);*/
1302                   reset_this_command_keys (Vselected_console, 1);
1303                   UNGCPRO;
1304
1305                   return Vmenu_accelerator_map;
1306                 }
1307             }
1308
1309           val = val->next;
1310         }
1311
1312       UNGCPRO;
1313     }
1314   return Qnil;
1315 }
1316
1317 int
1318 x_kludge_lw_menu_active (void)
1319 {
1320   return lw_menu_active;
1321 }
1322
1323 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
1324 Make the menubar active.  Menu items can be selected using menu accelerators
1325 or by actions defined in menu-accelerator-map.
1326 */
1327        ())
1328 {
1329   struct console *con = XCONSOLE (Vselected_console);
1330   struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
1331   LWLIB_ID id;
1332   widget_value *val;
1333
1334   if (NILP (f->menubar_data))
1335     error ("Frame has no menubar.");
1336
1337   id = XPOPUP_DATA (f->menubar_data)->id;
1338   val = lw_get_all_values (id);
1339   val = val->contents;
1340   lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
1341   lw_map_menu (CurrentTime);
1342
1343   lw_display_menu (CurrentTime);
1344
1345   /* menu accelerator keys don't go into keyboard macros */
1346   if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
1347     con->kbd_macro_ptr = con->kbd_macro_end;
1348
1349   return Qnil;
1350 }
1351 #endif /* LWLIB_MENUBARS_LUCID */
1352
1353 \f
1354 void
1355 syms_of_menubar_x (void)
1356 {
1357 #if defined(LWLIB_MENUBARS_LUCID)
1358   DEFSUBR (Faccelerate_menu);
1359 #endif
1360 }
1361
1362 void
1363 console_type_create_menubar_x (void)
1364 {
1365   CONSOLE_HAS_METHOD (x, update_frame_menubars);
1366   CONSOLE_HAS_METHOD (x, free_frame_menubars);
1367   CONSOLE_HAS_METHOD (x, popup_menu);
1368 }
1369
1370 void
1371 reinit_vars_of_menubar_x (void)
1372 {
1373   last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
1374 }
1375
1376 void
1377 vars_of_menubar_x (void)
1378 {
1379   reinit_vars_of_menubar_x ();
1380
1381 #if defined (LWLIB_MENUBARS_LUCID)
1382   Fprovide (intern ("lucid-menubars"));
1383 #elif defined (LWLIB_MENUBARS_MOTIF)
1384   Fprovide (intern ("motif-menubars"));
1385 #elif defined (LWLIB_MENUBARS_ATHENA)
1386   Fprovide (intern ("athena-menubars"));
1387 #endif
1388 }