Mercurial > hg > xemacs-beta

comparison src/menubar-x.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 "events.h"
38 #include "frame.h"
39 #include "opaque.h"
40 #include "window.h"
41
42 static int set_frame_menubar (struct frame *f,
43 int deep_p,
44 int first_time_p);
45
46 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
47 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
48
49 #define MENUBAR_TYPE 0
50 #define SUBMENU_TYPE 1
51 #define POPUP_TYPE 2
52
53
54 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
55
56 menu_item_descriptor_to_widget_value() converts a lisp description of a
57 menubar into a tree of widget_value structures. It allocates widget_values
58 with malloc_widget_value() and allocates other storage only for the `key'
59 slot. All other slots are filled with pointers to Lisp_String data. We
60 allocate a widget_value description of the menu or menubar, and hand it to
61 lwlib, which then makes a copy of it, which it manages internally. We then
62 immediately free our widget_value tree; it will not be referenced again.
63
64 Incremental menu construction callbacks operate just a bit differently.
65 They allocate widget_values and call replace_widget_value_tree() to tell
66 lwlib to destructively modify the incremental stub (subtree) of its
67 separate widget_value tree.
68
69 This function is highly recursive (it follows the menu trees) and may call
70 eval. The reason we keep pointers to lisp string data instead of copying
71 it and freeing it later is to avoid the speed penalty that would entail
72 (since this needs to be fast, in the simple cases at least). (The reason
73 we malloc/free the keys slot is because there's not a lisp string around
74 for us to use in that case.)
75
76 Since we keep pointers to lisp strings, and we call eval, we could lose if
77 GC relocates (or frees) those strings. It's not easy to gc protect the
78 strings because of the recursive nature of this function, and the fact that
79 it returns a data structure that gets freed later. So... we do the
80 sleaziest thing possible and inhibit GC for the duration. This is probably
81 not a big deal...
82
83 We do not have to worry about the pointers to Lisp_String data after
84 this function successfully finishes. lwlib copies all such data with
85 strdup().
86
87 */
88
89 static widget_value *
90 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
91 int menu_type, int deep_p,
92 int filter_p,
93 int depth)
94 {
95 /* This function cannot GC.
96 It is only called from menu_item_descriptor_to_widget_value, which
97 prohibits GC. */
98 /* !!#### This function has not been Mule-ized */
99 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
100 widget_value *wv;
101 Lisp_Object wv_closure;
102 int count = specpdl_depth ();
103 int partition_seen = 0;
104
105 wv = xmalloc_widget_value ();
106
107 wv_closure = make_opaque_ptr (wv);
108 record_unwind_protect (widget_value_unwind, wv_closure);
109
110 if (STRINGP (desc))
111 {
112 char *string_chars = (char *) string_data (XSTRING (desc));
113 wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
114 TEXT_TYPE);
115 #if 1
116 /* #### - should internationalize with X resources instead.
117 Not so! --ben */
118 string_chars = GETTEXT (string_chars);
119 #endif
120 if (wv->type == SEPARATOR_TYPE)
121 {
122 wv->value = menu_separator_style (string_chars);
123 }
124 else
125 {
126 wv->name = string_chars;
127 wv->enabled = 1;
128 }
129 }
130 else if (VECTORP (desc))
131 {
132 if (!button_item_to_widget_value (desc, wv, 1,
133 (menu_type == MENUBAR_TYPE
134 && depth <= 1)))
135 {
136 /* :included form was nil */
137 wv = NULL;
138 goto menu_item_done;
139 }
140 }
141 else if (CONSP (desc))
142 {
143 Lisp_Object incremental_data = desc;
144 widget_value *prev = 0;
145
146 if (STRINGP (XCAR (desc)))
147 {
148 Lisp_Object key, val;
149 Lisp_Object include_p, hook_fn = Qnil, config_tag = Qnil;
150 int included_spec = 0;
151 wv->type = CASCADE_TYPE;
152 wv->enabled = 1;
153 wv->name =
154 (char *) string_data (XSTRING (LISP_GETTEXT (XCAR (desc))));
155 desc = Fcdr (desc);
156
157 while (key = Fcar (desc), KEYWORDP (key))
158 {
159 Lisp_Object cascade = desc;
160 desc = Fcdr (desc);
161 if (NILP (desc))
162 signal_simple_error ("keyword in menu lacks a value",
163 cascade);
164 val = Fcar (desc);
165 desc = Fcdr (desc);
166 if (EQ (key, Q_included))
167 include_p = val, included_spec = 1;
168 else if (EQ (key, Q_config))
169 config_tag = val;
170 else if (EQ (key, Q_filter))
171 hook_fn = val;
172 else
173 signal_simple_error ("unknown menu cascade keyword", cascade);
174 }
175
176 if ((!NILP (config_tag)
177 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
178 || (included_spec && NILP (Feval (include_p))))
179 {
180 wv = NULL;
181 goto menu_item_done;
182 }
183 if (!NILP (hook_fn))
184 {
185 #ifdef LWLIB_MENUBARS_LUCID
186 if (filter_p || depth == 0)
187 {
188 #endif
189 desc = call1_trapping_errors ("Error in menubar filter",
190 hook_fn, desc);
191 if (UNBOUNDP (desc))
192 desc = Qnil;
193 #ifdef LWLIB_MENUBARS_LUCID
194 }
195 else
196 {
197 widget_value *incr_wv = xmalloc_widget_value ();
198 wv->contents = incr_wv;
199 incr_wv->type = INCREMENTAL_TYPE;
200 incr_wv->enabled = 1;
201 incr_wv->name = wv->name;
202 /* This is automatically GC protected through
203 the call to lw_map_widget_values(); no need
204 to worry. */
205 incr_wv->call_data = LISP_TO_VOID (incremental_data);
206 goto menu_item_done;
207 }
208 #endif
209 }
210 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
211 {
212 /* Simply prepend three more widget values to the contents of
213 the menu: a label, and two separators (to get a double
214 line). */
215 widget_value *title_wv = xmalloc_widget_value ();
216 widget_value *sep_wv = xmalloc_widget_value ();
217 title_wv->type = TEXT_TYPE;
218 title_wv->name = wv->name;
219 title_wv->enabled = 1;
220 title_wv->next = sep_wv;
221 sep_wv->type = SEPARATOR_TYPE;
222 sep_wv->value = menu_separator_style ("==");
223 sep_wv->next = 0;
224
225 wv->contents = title_wv;
226 prev = sep_wv;
227 }
228 }
229 else if (menubar_root_p)
230 {
231 wv->name = "menubar";
232 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
233 this is ignored anyway... */
234 }
235 else
236 {
237 signal_simple_error ("menu name (first element) must be a string",
238 desc);
239 }
240
241 wv->enabled = 1;
242 if (deep_p || menubar_root_p)
243 {
244 widget_value *next;
245 for (; !NILP (desc); desc = Fcdr (desc))
246 {
247 Lisp_Object child = Fcar (desc);
248 if (menubar_root_p && NILP (child)) /* the partition */
249 {
250 if (partition_seen)
251 error (
252 "more than one partition (nil) in menubar description");
253 partition_seen = 1;
254 next = xmalloc_widget_value ();
255 next->type = PUSHRIGHT_TYPE;
256 }
257 else
258 {
259 next = menu_item_descriptor_to_widget_value_1 (child,
260 menu_type,
261 deep_p,
262 filter_p,
263 depth + 1);
264 }
265 if (! next)
266 continue;
267 else if (prev)
268 prev->next = next;
269 else
270 wv->contents = next;
271 prev = next;
272 }
273 }
274 if (deep_p && !wv->contents)
275 wv = NULL;
276 }
277 else if (NILP (desc))
278 error ("nil may not appear in menu descriptions");
279 else
280 signal_simple_error ("unrecognized menu descriptor", desc);
281
282 menu_item_done:
283
284 if (wv)
285 {
286 /* Completed normally. Clear out the object that widget_value_unwind()
287 will be called with to tell it not to free the wv (as we are
288 returning it.) */
289 set_opaque_ptr (wv_closure, 0);
290 }
291
292 unbind_to (count, Qnil);
293 return wv;
294 }
295
296 static widget_value *
297 menu_item_descriptor_to_widget_value (Lisp_Object desc,
298 int menu_type, /* if this is a menubar,
299 popup or sub menu */
300 int deep_p, /* */
301 int filter_p) /* if :filter forms
302 should run now */
303 {
304 widget_value *wv;
305 int count = specpdl_depth ();
306 record_unwind_protect (restore_gc_inhibit,
307 make_int (gc_currently_forbidden));
308 gc_currently_forbidden = 1;
309 /* Can't GC! */
310 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
311 filter_p, 0);
312 unbind_to (count, Qnil);
313 return wv;
314 }
315
316
317 /* The order in which callbacks are run is funny to say the least.
318 It's sometimes tricky to avoid running a callback twice, and to
319 avoid returning prematurely. So, this function returns true
320 if the menu's callbacks are no longer gc protected. So long
321 as we unprotect them before allowing other callbacks to run,
322 everything should be ok.
323
324 The pre_activate_callback() *IS* intentionally called multiple times.
325 If client_data == NULL, then it's being called before the menu is posted.
326 If client_data != NULL, then client_data is a (widget_value *) and
327 client_data->data is a Lisp_Object pointing to a lisp submenu description
328 that must be converted into widget_values. *client_data is destructively
329 modified.
330
331 #### Stig thinks that there may be a GC problem here due to the
332 fact that pre_activate_callback() is called multiple times, but I
333 think he's wrong.
334
335 */
336
337 static void
338 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
339 {
340 /* This function can GC */
341 struct gcpro gcpro1;
342 struct device *d = get_device_from_display (XtDisplay (widget));
343 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
344 Lisp_Object rest = Qnil;
345 int any_changes = 0;
346
347 if (!f)
348 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
349 if (!f)
350 return;
351
352 if (client_data)
353 {
354 /* this is an incremental menu construction callback */
355 widget_value *hack_wv = (widget_value *) client_data;
356 Lisp_Object submenu_desc;
357 widget_value *wv;
358
359 assert (hack_wv->type == INCREMENTAL_TYPE);
360 VOID_TO_LISP (submenu_desc, hack_wv->call_data);
361 wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
362 1, 1);
363 if (!wv)
364 {
365 wv = xmalloc_widget_value ();
366 wv->type = CASCADE_TYPE;
367 wv->next = NULL;
368 wv->contents = xmalloc_widget_value ();
369 wv->contents->type = TEXT_TYPE;
370 wv->contents->name = "No menu";
371 wv->contents->next = NULL;
372 }
373 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
374 replace_widget_value_tree (hack_wv, wv->contents);
375 free_popup_widget_value_tree (wv);
376 }
377 else
378 {
379 if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
380 return;
381 /* #### - this menubar update mechanism is expensively anti-social and
382 the activate-menubar-hook is now mostly obsolete. */
383 /* make the activate-menubar-hook be a list of functions, not a single
384 function, just to simplify things. */
385 if (!NILP (Vactivate_menubar_hook) &&
386 (!CONSP (Vactivate_menubar_hook) ||
387 EQ (XCAR (Vactivate_menubar_hook), Qlambda)))
388 Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil);
389
390 GCPRO1 (rest);
391 for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest))
392 if (!EQ (call0 (XCAR (rest)), Qt))
393 any_changes = 1;
394 #if 0
395 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
396 incremental menus are implemented. If a subtree of a menu has been
397 updated incrementally (a destructive operation), then that subtree
398 must somehow be wiped.
399
400 It is difficult to undo the destructive operation in lwlib because
401 a pointer back to lisp data needs to be hidden away somewhere. So
402 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
403 if (any_changes ||
404 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
405 #endif
406 set_frame_menubar (f, 1, 0);
407 UNGCPRO;
408 }
409 }
410
411 #ifdef ENERGIZE
412 extern int *get_psheets_for_buffer (Lisp_Object, int *);
413
414 static void
415 set_panel_button_sensitivity (struct frame *f, widget_value *data)
416 {
417 struct window *window = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
418 int current_buffer_psheets_count = 0;
419 int *current_buffer_psheets =
420 get_psheets_for_buffer (window->buffer, &current_buffer_psheets_count);
421 int panel_enabled = FRAME_X_DESIRED_PSHEETS (f) ||
422 current_buffer_psheets_count;
423 widget_value *val;
424 for (val = data->contents; val; val = val->next)
425 if (val->name && !strcmp (val->name, "sheet"))
426 {
427 val->enabled = panel_enabled;
428 return;
429 }
430 }
431 #endif /* ENERGIZE */
432
433 static widget_value *
434 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
435 {
436 widget_value *data;
437
438 if (NILP (menubar))
439 data = 0;
440 else
441 {
442 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
443 deep_p, 0);
444 #ifdef ENERGIZE
445 if (data)
446 set_panel_button_sensitivity (f, data);
447 #endif
448 }
449 return data;
450 }
451
452 static int
453 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
454 {
455 widget_value *data;
456 Lisp_Object menubar;
457 int menubar_visible;
458 long id;
459 /* As for the toolbar, the minibuffer does not have its own menubar. */
460 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
461
462 if (! FRAME_X_P (f))
463 return 0;
464
465 /***** first compute the contents of the menubar *****/
466
467 if (! first_time_p)
468 {
469 /* evaluate `current-menubar' in the buffer of the selected window
470 of the frame in question. */
471 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
472 }
473 else
474 {
475 /* That's a little tricky the first time since the frame isn't
476 fully initialized yet. */
477 menubar = Fsymbol_value (Qcurrent_menubar);
478 }
479
480 if (NILP (menubar))
481 {
482 menubar = Vblank_menubar;
483 menubar_visible = 0;
484 }
485 else
486 menubar_visible = !NILP (w->menubar_visible_p);
487
488 data = compute_menubar_data (f, menubar, deep_p);
489 if (!data || (!data->next && !data->contents))
490 abort ();
491
492 if (NILP (FRAME_MENUBAR_DATA (f)))
493 {
494 struct popup_data *mdata =
495 alloc_lcrecord (sizeof (struct popup_data), lrecord_popup_data);
496
497 mdata->id = new_lwlib_id ();
498 mdata->last_menubar_buffer = Qnil;
499 mdata->menubar_contents_up_to_date = 0;
500 XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
501 }
502
503 /***** now store into the menubar widget, creating it if necessary *****/
504
505 id = XFRAME_MENUBAR_DATA (f)->id;
506 if (!FRAME_X_MENUBAR_WIDGET (f))
507 {
508 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
509
510 assert (first_time_p);
511
512 /* It's the first time we've mapped the menubar so compute its
513 contents completely once. This makes sure that the menubar
514 components are created with the right type. */
515 if (!deep_p)
516 {
517 free_popup_widget_value_tree (data);
518 data = compute_menubar_data (f, menubar, 1);
519 }
520
521
522 FRAME_X_MENUBAR_WIDGET (f) =
523 lw_create_widget ("menubar", "menubar", id, data, parent,
524 0, pre_activate_callback,
525 popup_selection_callback, 0);
526
527 }
528 else
529 {
530 lw_modify_all_widgets (id, data, deep_p ? True : False);
531 }
532 free_popup_widget_value_tree (data);
533
534 XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
535 XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
536 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
537 return menubar_visible;
538 }
539
540
541 /* Called from x_create_widgets() to create the inital menubar of a frame
542 before it is mapped, so that the window is mapped with the menubar already
543 there instead of us tacking it on later and thrashing the window after it
544 is visible. */
545 int
546 x_initialize_frame_menubar (struct frame *f)
547 {
548 return set_frame_menubar (f, 1, 1);
549 }
550
551
552 static LWLIB_ID last_popup_menu_selection_callback_id;
553
554 static void
555 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
556 XtPointer client_data)
557 {
558 last_popup_menu_selection_callback_id = id;
559 popup_selection_callback (widget, id, client_data);
560 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
561 }
562
563 static void
564 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
565 {
566 if (popup_handled_p (id))
567 return;
568 assert (popup_up_p != 0);
569 ungcpro_popup_callbacks (id);
570 popup_up_p--;
571 /* if this isn't called immediately after the selection callback, then
572 there wasn't a menu selection. */
573 if (id != last_popup_menu_selection_callback_id)
574 popup_selection_callback (widget, id, (XtPointer) -1);
575 lw_destroy_all_widgets (id);
576 }
577
578
579 static void
580 make_dummy_xbutton_event (XEvent *dummy,
581 Widget daddy,
582 struct Lisp_Event *eev)
583 /* NULL for eev means query pointer */
584 {
585 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
586
587 btn->type = ButtonPress;
588 btn->serial = 0;
589 btn->send_event = 0;
590 btn->display = XtDisplay (daddy);
591 btn->window = XtWindow (daddy);
592 if (eev)
593 {
594 Position shellx, shelly, framex, framey;
595 Widget shell = XtParent (daddy);
596 btn->time = eev->timestamp;
597 btn->button = eev->event.button.button;
598 btn->root = RootWindowOfScreen (XtScreen (daddy));
599 btn->subwindow = (Window) NULL;
600 btn->x = eev->event.button.x;
601 btn->y = eev->event.button.y;
602 XtVaGetValues (shell, XtNx, &shellx, XtNy, &shelly, NULL);
603 XtVaGetValues (daddy, XtNx, &framex, XtNy, &framey, NULL);
604 btn->x_root = shellx + framex + btn->x;
605 btn->y_root = shelly + framey + btn->y;;
606 btn->state = ButtonPressMask; /* all buttons pressed */
607 }
608 else
609 {
610 /* CurrentTime is just ZERO, so it's worthless for
611 determining relative click times. */
612 struct device *d = get_device_from_display (XtDisplay (daddy));
613 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
614 btn->button = 0;
615 XQueryPointer (btn->display, btn->window, &btn->root,
616 &btn->subwindow, &btn->x_root, &btn->y_root,
617 &btn->x, &btn->y, &btn->state);
618 }
619 }
620
621
622 #ifdef ENERGIZE
623 extern int desired_debuggerpanel_exposed_p;
624 extern int current_debuggerpanel_exposed_p;
625 extern int debuggerpanel_sheet;
626 extern void notify_energize_sheet_hidden (unsigned long);
627 #endif
628
629 static void
630 x_update_frame_menubar_internal (struct frame *f)
631 {
632 /* We assume the menubar contents has changed if the global flag is set,
633 or if the current buffer has changed, or if the menubar has never
634 been updated before.
635 */
636 int menubar_contents_changed =
637 (f->menubar_changed
638 || NILP (FRAME_MENUBAR_DATA (f))
639 || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
640 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
641
642 int menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
643 int menubar_will_be_visible = menubar_was_visible;
644 int menubar_visibility_changed;
645 Cardinal new_num_top_widgets = 1; /* for the menubar */
646 Widget container = FRAME_X_CONTAINER_WIDGET (f);
647
648 #ifdef ENERGIZE
649 int *old_sheets = FRAME_X_CURRENT_PSHEETS (f);
650 int *new_sheets = FRAME_X_DESIRED_PSHEETS (f);
651 int old_count = FRAME_X_CURRENT_PSHEET_COUNT (f);
652 int new_count = FRAME_X_DESIRED_PSHEET_COUNT (f);
653 Lisp_Object old_buf = FRAME_X_CURRENT_PSHEET_BUFFER (f);
654 Lisp_Object new_buf = FRAME_X_DESIRED_PSHEET_BUFFER (f);
655 int psheets_changed = (old_sheets != new_sheets
656 || old_count != new_count
657 || !EQ (old_buf, new_buf));
658 int debuggerpanel_changed = (desired_debuggerpanel_exposed_p
659 != current_debuggerpanel_exposed_p);
660
661 if (desired_debuggerpanel_exposed_p && FRAME_X_TOP_WIDGETS (f) [1] == 0)
662 /* This happens when the frame was just created. */
663 debuggerpanel_changed = 1;
664
665 FRAME_X_CURRENT_PSHEETS (f) = FRAME_X_DESIRED_PSHEETS (f);
666 FRAME_X_CURRENT_PSHEET_COUNT (f) = FRAME_X_DESIRED_PSHEET_COUNT (f);
667 FRAME_X_CURRENT_PSHEET_BUFFER (f) = FRAME_X_DESIRED_PSHEET_BUFFER (f);
668 #endif /* ENERGIZE */
669
670 if (menubar_contents_changed)
671 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
672
673 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
674
675 if (! (menubar_visibility_changed
676 #ifdef ENERGIZE
677 || psheets_changed || debuggerpanel_changed
678 #endif
679 ))
680 return;
681
682
683 /* Set menubar visibility */
684 if (menubar_visibility_changed)
685 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
686 (FRAME_X_MENUBAR_WIDGET (f));
687
688
689 #ifdef ENERGIZE
690 /* Set debugger panel visibility */
691 if (debuggerpanel_changed)
692 {
693 Widget w;
694 int sheet = debuggerpanel_sheet;
695
696 w = lw_get_widget (sheet, container, 0);
697 if (desired_debuggerpanel_exposed_p)
698 {
699 if (! w)
700 w = lw_make_widget (sheet, container, 0);
701 FRAME_X_TOP_WIDGETS (f)[1] = w;
702 XtManageChild (w);
703 }
704 else
705 {
706 notify_energize_sheet_hidden (sheet);
707 if (w)
708 XtUnmanageChild (w);
709 }
710 }
711
712 /* Set psheet visibility. For the moment we just unmanage all the old
713 ones, and then manage all the new ones. If the number of psheets
714 ever becomes a large number (i.e. > 1), then we can worry about a
715 more sophisticated way of doing this. */
716 if (psheets_changed)
717 {
718 int i;
719 Widget w;
720 unsigned long sheet;
721
722 for (i=0; i<old_count; i++)
723 {
724 sheet = old_sheets[i];
725 w = lw_get_widget (sheet, container, 0);
726 notify_energize_sheet_hidden (sheet);
727 if (w)
728 XtUnmanageChild (w);
729 }
730
731 for (i=0; i<new_count; i++)
732 {
733 sheet = new_sheets[i];
734 /* #### This unconditional call to lw_make_widget() is a bad
735 idea. Doesn't it cause a memory leak if the widget
736 already exists?
737
738 #### How does Energize know that a sheet just got displayed?
739 #### Energize knows all. */
740 w = lw_make_widget (sheet, container, 0);
741 FRAME_X_TOP_WIDGETS (f)[2+i] = w;
742 XtManageChild (w);
743 }
744 }
745
746 new_num_top_widgets += 1+new_count;
747 #endif /* ENERGIZE */
748
749 /* Note that new_num_top_widgets doesn't need to reflect the actual
750 number of top widgets, but just the limit of FRAME_X_TOP_WIDGETS (f)[]. */
751 FRAME_X_NUM_TOP_WIDGETS (f) = new_num_top_widgets;
752 {
753 /* We want to end up as close in size as possible to what we
754 were before. So, ask the EmacsManager what size it wants
755 to be (suggesting the current size), and resize it to that
756 size. It in turn will call our query-geometry callback,
757 which will round the size to something that exactly fits
758 the text widget. */
759 XtWidgetGeometry req, repl;
760
761 req.request_mode = CWWidth | CWHeight;
762 XtVaGetValues (container,
763 XtNwidth, &req.width,
764 XtNheight, &req.height,
765 0);
766 XtQueryGeometry (container, &req, &repl);
767 EmacsManagerChangeSize (container, repl.width,
768 repl.height);
769 /* The window size might not have changed but the text size
770 did; thus, the base size might be incorrect. So update
771 it. */
772 EmacsShellUpdateSizeHints (FRAME_X_SHELL_WIDGET (f));
773 }
774
775 #ifdef ENERGIZE
776 /* Give back the focus to emacs if no psheets are displayed anymore */
777 if (psheets_changed)
778 {
779 Lisp_Object frame;
780 XSETFRAME (frame, f);
781 Fselect_frame (frame);
782 }
783 #endif /* ENERGIZE */
784 }
785
786 static void
787 x_update_frame_menubars (struct frame *f)
788 {
789 assert (FRAME_X_P (f));
790
791 x_update_frame_menubar_internal (f);
792
793 /* #### This isn't going to work right now that this function works on
794 a per-frame, not per-device basis. Guess what? I don't care. */
795 #ifdef ENERGIZE
796 current_debuggerpanel_exposed_p = desired_debuggerpanel_exposed_p;
797 #endif
798 }
799
800 static void
801 x_free_frame_menubars (struct frame *f)
802 {
803 Widget menubar_widget;
804
805 assert (FRAME_X_P (f));
806
807 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
808 if (menubar_widget)
809 {
810 LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
811 lw_destroy_all_widgets (id);
812 XFRAME_MENUBAR_DATA (f)->id = 0;
813 }
814
815 #ifdef ENERGIZE
816 {
817 /* Also destroy this frame's psheets */
818 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
819 int *sheets = FRAME_X_CURRENT_PSHEETS (f);
820 int i = FRAME_X_CURRENT_PSHEET_COUNT (f);
821 while (i--)
822 {
823 unsigned long sheet = sheets [i];
824 Widget w = lw_get_widget (sheet, parent, 0);
825 if (w)
826 lw_destroy_widget (w);
827 }
828 FRAME_X_CURRENT_PSHEET_COUNT (f) = 0;
829
830 /* Is this necessary? */
831 sheets = FRAME_X_DESIRED_PSHEETS (f);
832 i = FRAME_X_DESIRED_PSHEET_COUNT (f);
833 while (i--)
834 {
835 unsigned long sheet = sheets [i];
836 Widget w = lw_get_widget (sheet, parent, 0);
837 if (w)
838 lw_destroy_widget (w);
839 }
840 FRAME_X_DESIRED_PSHEET_COUNT (f) = 0;
841
842 /* sigh... debugger panel is special... */
843 if (debuggerpanel_sheet)
844 {
845 Widget w = lw_get_widget (debuggerpanel_sheet, parent, 0);
846 if (w)
847 lw_destroy_widget (w);
848 }
849 }
850 #endif /* ENERGIZE */
851 }
852
853 static void
854 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
855 {
856 int menu_id;
857 struct frame *f = selected_frame ();
858 widget_value *data;
859 Widget parent;
860 Widget menu;
861 struct Lisp_Event *eev = NULL;
862 XEvent xev;
863 Lisp_Object frame = Qnil;
864
865 XSETFRAME (frame, f);
866 CHECK_X_FRAME (frame);
867 parent = FRAME_X_SHELL_WIDGET (f);
868
869 if (!NILP (event))
870 {
871 CHECK_LIVE_EVENT (event);
872 eev= XEVENT (event);
873 if (eev->event_type != button_press_event
874 && eev->event_type != button_release_event)
875 wrong_type_argument (Qmouse_event_p, event);
876 }
877 else if (!NILP (Vthis_command_keys))
878 {
879 /* if an event wasn't passed, use the last event of the event sequence
880 currently being executed, if that event is a mouse event */
881 eev = XEVENT (Vthis_command_keys); /* last event first */
882 if (eev->event_type != button_press_event
883 && eev->event_type != button_release_event)
884 eev = NULL;
885 }
886 make_dummy_xbutton_event (&xev, parent, eev);
887
888 if (SYMBOLP (menu_desc))
889 menu_desc = Fsymbol_value (menu_desc);
890 CHECK_CONS (menu_desc);
891 CHECK_STRING (XCAR (menu_desc));
892 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
893
894 if (! data) error ("no menu");
895
896 menu_id = new_lwlib_id ();
897 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
898 parent, 1, 0,
899 popup_menu_selection_callback,
900 popup_menu_down_callback);
901 free_popup_widget_value_tree (data);
902
903 gcpro_popup_callbacks (menu_id);
904
905 /* Setting zmacs-region-stays is necessary here because executing a command
906 from a menu is really a two-command process: the first command (bound to
907 the button-click) simply pops up the menu, and returns. This causes a
908 sequence of magic-events (destined for the popup-menu widget) to begin.
909 Eventually, a menu item is selected, and a menu-event blip is pushed onto
910 the end of the input stream, which is then executed by the event loop.
911
912 So there are two command-events, with a bunch of magic-events between
913 them. We don't want the *first* command event to alter the state of the
914 region, so that the region can be available as an argument for the second
915 command.
916 */
917 if (zmacs_regions)
918 zmacs_region_stays = 1;
919
920 popup_up_p++;
921 lw_popup_menu (menu, &xev);
922 /* this speeds up display of pop-up menus */
923 XFlush (XtDisplay (parent));
924 }
925
926
927 void
928 syms_of_menubar_x (void)
929 {
930 }
931
932 void
933 console_type_create_menubar_x (void)
934 {
935 CONSOLE_HAS_METHOD (x, update_frame_menubars);
936 CONSOLE_HAS_METHOD (x, free_frame_menubars);
937 CONSOLE_HAS_METHOD (x, popup_menu);
938 }
939
940 void
941 vars_of_menubar_x (void)
942 {
943 last_popup_menu_selection_callback_id = -1;
944
945 #if defined (LWLIB_MENUBARS_LUCID)
946 Fprovide (intern ("lucid-menubars"));
947 #elif defined (LWLIB_MENUBARS_MOTIF)
948 Fprovide (intern ("motif-menubars"));
949 #elif defined (LWLIB_MENUBARS_ATHENA)
950 Fprovide (intern ("athena-menubars"));
951 #endif
952 }