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