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.
1261
+ − 4 Copyright (C) 2000, 2001, 2002, 2003 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 {
442
+ − 125 LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, 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 */
+ − 131 wv->accel = LISP_TO_VOID (Qnil);
+ − 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));
428
+ − 165 wv->accel = LISP_TO_VOID (accel);
+ − 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))
+ − 189 wv->accel = LISP_TO_VOID (val);
+ − 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. */
+ − 234 incr_wv->call_data = LISP_TO_VOID (incremental_data);
+ − 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)");
428
+ − 264 dummy->accel = LISP_TO_VOID (Qnil);
+ − 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
+ − 339 static widget_value *
+ − 340 menu_item_descriptor_to_widget_value (Lisp_Object desc,
+ − 341 int menu_type, /* if this is a menubar,
442
+ − 342 popup or sub menu */
428
+ − 343 int deep_p, /* */
+ − 344 int filter_p) /* if :filter forms
+ − 345 should run now */
+ − 346 {
+ − 347 widget_value *wv;
771
+ − 348 int count = begin_gc_forbidden ();
428
+ − 349 /* Can't GC! */
+ − 350 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
+ − 351 filter_p, 0);
771
+ − 352 unbind_to (count);
428
+ − 353 return wv;
+ − 354 }
+ − 355
853
+ − 356 struct menu_item_descriptor_to_widget_value
+ − 357 {
+ − 358 Lisp_Object desc;
+ − 359 int menu_type, deep_p, filter_p;
+ − 360 widget_value *wv;
+ − 361 };
428
+ − 362
+ − 363 static Lisp_Object
853
+ − 364 protected_menu_item_descriptor_to_widget_value_1 (void *gack)
428
+ − 365 {
853
+ − 366 struct menu_item_descriptor_to_widget_value *midtwv =
+ − 367 (struct menu_item_descriptor_to_widget_value *) gack;
+ − 368
+ − 369 midtwv->wv = menu_item_descriptor_to_widget_value (midtwv->desc,
+ − 370 midtwv->menu_type,
+ − 371 midtwv->deep_p,
+ − 372 midtwv->filter_p);
442
+ − 373 return Qnil;
428
+ − 374 }
853
+ − 375
+ − 376 /* Inside of the pre_activate_callback, we absolutely need to protect
+ − 377 against errors, esp. but not exclusively in the filter code. (We do
+ − 378 other evalling, too.) We also need to reenable quit checking, which
+ − 379 was disabled by next_event_internal() so as to read C-g as an
+ − 380 event. */
428
+ − 381
853
+ − 382 static widget_value *
+ − 383 protected_menu_item_descriptor_to_widget_value (Lisp_Object desc,
+ − 384 int menu_type, int deep_p,
+ − 385 int filter_p)
428
+ − 386 {
853
+ − 387 struct menu_item_descriptor_to_widget_value midtwv;
1279
+ − 388 int depth = internal_bind_int (&in_menu_callback, 1);
+ − 389 Lisp_Object retval;
428
+ − 390
853
+ − 391 midtwv.desc = desc;
+ − 392 midtwv.menu_type = menu_type;
+ − 393 midtwv.deep_p = deep_p;
+ − 394 midtwv.filter_p = filter_p;
428
+ − 395
1279
+ − 396 retval = event_stream_protect_modal_loop
+ − 397 ("Error during menu callback",
+ − 398 protected_menu_item_descriptor_to_widget_value_1, &midtwv,
+ − 399 UNINHIBIT_QUIT);
+ − 400 unbind_to (depth);
+ − 401
+ − 402 if (UNBOUNDP (retval))
853
+ − 403 return 0;
+ − 404
+ − 405 return midtwv.wv;
428
+ − 406 }
853
+ − 407
428
+ − 408 /* The order in which callbacks are run is funny to say the least.
+ − 409 It's sometimes tricky to avoid running a callback twice, and to
+ − 410 avoid returning prematurely. So, this function returns true
+ − 411 if the menu's callbacks are no longer gc protected. So long
+ − 412 as we unprotect them before allowing other callbacks to run,
+ − 413 everything should be ok.
+ − 414
+ − 415 The pre_activate_callback() *IS* intentionally called multiple times.
+ − 416 If client_data == NULL, then it's being called before the menu is posted.
+ − 417 If client_data != NULL, then client_data is a (widget_value *) and
+ − 418 client_data->data is a Lisp_Object pointing to a lisp submenu description
+ − 419 that must be converted into widget_values. *client_data is destructively
+ − 420 modified.
+ − 421
+ − 422 #### Stig thinks that there may be a GC problem here due to the
+ − 423 fact that pre_activate_callback() is called multiple times, but I
+ − 424 think he's wrong.
+ − 425
+ − 426 */
+ − 427
+ − 428 static void
+ − 429 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
+ − 430 {
+ − 431 /* This function can GC */
+ − 432 struct device *d = get_device_from_display (XtDisplay (widget));
+ − 433 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
+ − 434 Lisp_Object frame;
+ − 435
+ − 436 /* set in lwlib to the time stamp associated with the most recent menu
+ − 437 operation */
+ − 438 extern Time x_focus_timestamp_really_sucks_fix_me_better;
+ − 439
+ − 440 if (!f)
+ − 441 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
+ − 442 if (!f)
+ − 443 return;
+ − 444
+ − 445 /* make sure f is the selected frame */
793
+ − 446 frame = wrap_frame (f);
428
+ − 447 Fselect_frame (frame);
+ − 448
+ − 449 if (client_data)
+ − 450 {
+ − 451 /* this is an incremental menu construction callback */
+ − 452 widget_value *hack_wv = (widget_value *) client_data;
+ − 453 Lisp_Object submenu_desc;
+ − 454 widget_value *wv;
+ − 455
+ − 456 assert (hack_wv->type == INCREMENTAL_TYPE);
826
+ − 457 submenu_desc = VOID_TO_LISP (hack_wv->call_data);
428
+ − 458
853
+ − 459 wv = (protected_menu_item_descriptor_to_widget_value
+ − 460 (submenu_desc, SUBMENU_TYPE, 1, 0));
428
+ − 461
+ − 462 if (!wv)
+ − 463 {
+ − 464 wv = xmalloc_widget_value ();
+ − 465 wv->type = CASCADE_TYPE;
+ − 466 wv->next = NULL;
+ − 467 wv->accel = LISP_TO_VOID (Qnil);
+ − 468 wv->contents = xmalloc_widget_value ();
+ − 469 wv->contents->type = TEXT_TYPE;
436
+ − 470 wv->contents->name = xstrdup ("No menu");
428
+ − 471 wv->contents->next = NULL;
+ − 472 wv->contents->accel = LISP_TO_VOID (Qnil);
+ − 473 }
+ − 474 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
+ − 475 replace_widget_value_tree (hack_wv, wv->contents);
+ − 476 free_popup_widget_value_tree (wv);
1261
+ − 477 /* Now that we've destructively modified part of the widget value
+ − 478 hierarchy, our list of protected callbacks will no longer be
+ − 479 valid, so we need to recompute it. */
1346
+ − 480 gcpro_popup_callbacks (FRAME_X_MENUBAR_ID (f));
428
+ − 481 }
1346
+ − 482 else if (!FRAME_X_MENUBAR_ID (f))
428
+ − 483 return;
+ − 484 else
+ − 485 {
+ − 486 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
+ − 487 incremental menus are implemented. If a subtree of a menu has been
+ − 488 updated incrementally (a destructive operation), then that subtree
+ − 489 must somehow be wiped.
+ − 490
+ − 491 It is difficult to undo the destructive operation in lwlib because
+ − 492 a pointer back to lisp data needs to be hidden away somewhere. So
+ − 493 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
853
+ − 494 run_hook_trapping_problems
1333
+ − 495 (Qmenubar, Qactivate_menubar_hook,
853
+ − 496 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
428
+ − 497 set_frame_menubar (f, 1, 0);
+ − 498 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
+ − 499 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
+ − 500 x_focus_timestamp_really_sucks_fix_me_better;
+ − 501 }
+ − 502 }
+ − 503
+ − 504 static widget_value *
+ − 505 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
+ − 506 {
+ − 507 if (NILP (menubar))
438
+ − 508 return 0;
428
+ − 509 else
+ − 510 {
438
+ − 511 widget_value *data;
428
+ − 512 int count = specpdl_depth ();
+ − 513
438
+ − 514 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ − 515 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
428
+ − 516 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
+ − 517 deep_p, 0);
771
+ − 518 unbind_to (count);
438
+ − 519
+ − 520 return data;
428
+ − 521 }
+ − 522 }
+ − 523
+ − 524 static int
+ − 525 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
+ − 526 {
+ − 527 widget_value *data;
+ − 528 Lisp_Object menubar;
+ − 529 int menubar_visible;
+ − 530 long id;
438
+ − 531 /* As with the toolbar, the minibuffer does not have its own menubar. */
428
+ − 532 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
+ − 533
+ − 534 if (! FRAME_X_P (f))
+ − 535 return 0;
+ − 536
+ − 537 /***** first compute the contents of the menubar *****/
+ − 538
+ − 539 if (! first_time_p)
+ − 540 {
+ − 541 /* evaluate `current-menubar' in the buffer of the selected window
+ − 542 of the frame in question. */
+ − 543 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
+ − 544 }
+ − 545 else
+ − 546 {
+ − 547 /* That's a little tricky the first time since the frame isn't
+ − 548 fully initialized yet. */
+ − 549 menubar = Fsymbol_value (Qcurrent_menubar);
+ − 550 }
+ − 551
+ − 552 if (NILP (menubar))
+ − 553 {
+ − 554 menubar = Vblank_menubar;
+ − 555 menubar_visible = 0;
+ − 556 }
+ − 557 else
+ − 558 menubar_visible = !NILP (w->menubar_visible_p);
+ − 559
+ − 560 data = compute_menubar_data (f, menubar, deep_p);
+ − 561 if (!data || (!data->next && !data->contents))
+ − 562 abort ();
+ − 563
1346
+ − 564 if (!FRAME_X_MENUBAR_ID (f))
+ − 565 FRAME_X_MENUBAR_ID (f) = new_lwlib_id ();
428
+ − 566
+ − 567 /***** now store into the menubar widget, creating it if necessary *****/
+ − 568
1346
+ − 569 id = FRAME_X_MENUBAR_ID (f);
428
+ − 570 if (!FRAME_X_MENUBAR_WIDGET (f))
+ − 571 {
+ − 572 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
+ − 573
+ − 574 assert (first_time_p);
+ − 575
+ − 576 /* It's the first time we've mapped the menubar so compute its
+ − 577 contents completely once. This makes sure that the menubar
+ − 578 components are created with the right type. */
+ − 579 if (!deep_p)
+ − 580 {
+ − 581 free_popup_widget_value_tree (data);
+ − 582 data = compute_menubar_data (f, menubar, 1);
+ − 583 }
+ − 584
+ − 585
+ − 586 FRAME_X_MENUBAR_WIDGET (f) =
+ − 587 lw_create_widget ("menubar", "menubar", id, data, parent,
+ − 588 0, pre_activate_callback,
+ − 589 popup_selection_callback, 0);
+ − 590
+ − 591 }
+ − 592 else
+ − 593 {
+ − 594 lw_modify_all_widgets (id, data, deep_p ? True : False);
+ − 595 }
+ − 596 free_popup_widget_value_tree (data);
+ − 597
1261
+ − 598 /* Buried inside of the lwlib data are pointers to Lisp objects that may
+ − 599 have been freshly created. They need to be GC-protected, so snarf them
+ − 600 now and record them into the popup-data object associated with the
+ − 601 frame. */
1346
+ − 602 gcpro_popup_callbacks (id);
1261
+ − 603
1346
+ − 604 FRAME_X_MENUBAR_CONTENTS_UP_TO_DATE (f) = deep_p;
+ − 605 FRAME_X_LAST_MENUBAR_BUFFER (f) =
428
+ − 606 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
+ − 607 return menubar_visible;
+ − 608 }
+ − 609
+ − 610
+ − 611 /* Called from x_create_widgets() to create the initial menubar of a frame
+ − 612 before it is mapped, so that the window is mapped with the menubar already
+ − 613 there instead of us tacking it on later and thrashing the window after it
+ − 614 is visible. */
+ − 615 int
+ − 616 x_initialize_frame_menubar (struct frame *f)
+ − 617 {
+ − 618 return set_frame_menubar (f, 1, 1);
+ − 619 }
+ − 620
+ − 621
+ − 622 static LWLIB_ID last_popup_menu_selection_callback_id;
+ − 623
+ − 624 static void
+ − 625 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
+ − 626 XtPointer client_data)
+ − 627 {
+ − 628 last_popup_menu_selection_callback_id = id;
+ − 629 popup_selection_callback (widget, id, client_data);
+ − 630 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
+ − 631 }
+ − 632
+ − 633 static void
+ − 634 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
+ − 635 {
+ − 636 if (popup_handled_p (id))
+ − 637 return;
+ − 638 assert (popup_up_p != 0);
+ − 639 ungcpro_popup_callbacks (id);
+ − 640 popup_up_p--;
+ − 641 /* if this isn't called immediately after the selection callback, then
+ − 642 there wasn't a menu selection. */
+ − 643 if (id != last_popup_menu_selection_callback_id)
+ − 644 popup_selection_callback (widget, id, (XtPointer) -1);
+ − 645 lw_destroy_all_widgets (id);
+ − 646 }
+ − 647
+ − 648
+ − 649 static void
440
+ − 650 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
428
+ − 651 /* NULL for eev means query pointer */
+ − 652 {
+ − 653 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
+ − 654
+ − 655 btn->type = ButtonPress;
+ − 656 btn->serial = 0;
+ − 657 btn->send_event = 0;
+ − 658 btn->display = XtDisplay (daddy);
+ − 659 btn->window = XtWindow (daddy);
+ − 660 if (eev)
+ − 661 {
+ − 662 Position shellx, shelly, framex, framey;
+ − 663 Arg al [2];
934
+ − 664 btn->time = EVENT_TIMESTAMP (eev);
1204
+ − 665 btn->button = EVENT_BUTTON_BUTTON (eev);
934
+ − 666 btn->root = RootWindowOfScreen (XtScreen (daddy));
+ − 667 btn->subwindow = (Window) NULL;
1204
+ − 668 btn->x = EVENT_BUTTON_X (eev);
+ − 669 btn->y = EVENT_BUTTON_Y (eev);
428
+ − 670 shellx = shelly = 0;
+ − 671 #ifndef HAVE_WMCOMMAND
+ − 672 {
+ − 673 Widget shell = XtParent (daddy);
+ − 674
+ − 675 XtSetArg (al [0], XtNx, &shellx);
+ − 676 XtSetArg (al [1], XtNy, &shelly);
+ − 677 XtGetValues (shell, al, 2);
+ − 678 }
438
+ − 679 #endif
428
+ − 680 XtSetArg (al [0], XtNx, &framex);
+ − 681 XtSetArg (al [1], XtNy, &framey);
+ − 682 XtGetValues (daddy, al, 2);
+ − 683 btn->x_root = shellx + framex + btn->x;
+ − 684 btn->y_root = shelly + framey + btn->y;
+ − 685 btn->state = ButtonPressMask; /* all buttons pressed */
+ − 686 }
+ − 687 else
+ − 688 {
+ − 689 /* CurrentTime is just ZERO, so it's worthless for
+ − 690 determining relative click times. */
+ − 691 struct device *d = get_device_from_display (XtDisplay (daddy));
+ − 692 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
+ − 693 btn->button = 0;
+ − 694 XQueryPointer (btn->display, btn->window, &btn->root,
+ − 695 &btn->subwindow, &btn->x_root, &btn->y_root,
+ − 696 &btn->x, &btn->y, &btn->state);
+ − 697 }
+ − 698 }
+ − 699
+ − 700
+ − 701
+ − 702 static void
+ − 703 x_update_frame_menubar_internal (struct frame *f)
+ − 704 {
+ − 705 /* We assume the menubar contents has changed if the global flag is set,
+ − 706 or if the current buffer has changed, or if the menubar has never
+ − 707 been updated before.
+ − 708 */
+ − 709 int menubar_contents_changed =
+ − 710 (f->menubar_changed
1346
+ − 711 || !FRAME_X_MENUBAR_ID (f)
+ − 712 || (!EQ (FRAME_X_LAST_MENUBAR_BUFFER (f),
428
+ − 713 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
+ − 714
+ − 715 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
+ − 716 Boolean menubar_will_be_visible = menubar_was_visible;
+ − 717 Boolean menubar_visibility_changed;
+ − 718
+ − 719 if (menubar_contents_changed)
+ − 720 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
+ − 721
+ − 722 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
+ − 723
+ − 724 if (!menubar_visibility_changed)
+ − 725 return;
+ − 726
+ − 727 /* Set menubar visibility */
+ − 728 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
+ − 729 (FRAME_X_MENUBAR_WIDGET (f));
+ − 730
+ − 731 MARK_FRAME_SIZE_SLIPPED (f);
+ − 732 }
+ − 733
+ − 734 static void
+ − 735 x_update_frame_menubars (struct frame *f)
+ − 736 {
+ − 737 assert (FRAME_X_P (f));
+ − 738
+ − 739 x_update_frame_menubar_internal (f);
+ − 740
+ − 741 /* #### This isn't going to work right now that this function works on
+ − 742 a per-frame, not per-device basis. Guess what? I don't care. */
+ − 743 }
+ − 744
+ − 745 static void
+ − 746 x_free_frame_menubars (struct frame *f)
+ − 747 {
+ − 748 Widget menubar_widget;
+ − 749
+ − 750 assert (FRAME_X_P (f));
+ − 751
+ − 752 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
+ − 753 if (menubar_widget)
+ − 754 {
1346
+ − 755 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
428
+ − 756 lw_destroy_all_widgets (id);
1346
+ − 757 ungcpro_popup_callbacks (id);
+ − 758 FRAME_X_MENUBAR_ID (f) = 0;
428
+ − 759 }
+ − 760 }
+ − 761
+ − 762 static void
+ − 763 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
+ − 764 {
+ − 765 int menu_id;
+ − 766 struct frame *f = selected_frame ();
+ − 767 widget_value *data;
+ − 768 Widget parent;
+ − 769 Widget menu;
440
+ − 770 Lisp_Event *eev = NULL;
428
+ − 771 XEvent xev;
793
+ − 772 Lisp_Object frame = wrap_frame (f);
428
+ − 773
+ − 774 CHECK_X_FRAME (frame);
+ − 775 parent = FRAME_X_SHELL_WIDGET (f);
+ − 776
+ − 777 if (!NILP (event))
+ − 778 {
+ − 779 CHECK_LIVE_EVENT (event);
+ − 780 eev= XEVENT (event);
+ − 781 if (eev->event_type != button_press_event
+ − 782 && eev->event_type != button_release_event)
+ − 783 wrong_type_argument (Qmouse_event_p, event);
+ − 784 }
+ − 785 else if (!NILP (Vthis_command_keys))
+ − 786 {
+ − 787 /* if an event wasn't passed, use the last event of the event sequence
+ − 788 currently being executed, if that event is a mouse event */
+ − 789 eev = XEVENT (Vthis_command_keys); /* last event first */
+ − 790 if (eev->event_type != button_press_event
+ − 791 && eev->event_type != button_release_event)
+ − 792 eev = NULL;
+ − 793 }
+ − 794 make_dummy_xbutton_event (&xev, parent, eev);
+ − 795
+ − 796 if (SYMBOLP (menu_desc))
+ − 797 menu_desc = Fsymbol_value (menu_desc);
+ − 798 CHECK_CONS (menu_desc);
+ − 799 CHECK_STRING (XCAR (menu_desc));
+ − 800 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
+ − 801
563
+ − 802 if (! data) signal_error (Qgui_error, "no menu", Qunbound);
428
+ − 803
+ − 804 menu_id = new_lwlib_id ();
+ − 805 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
+ − 806 parent, 1, 0,
+ − 807 popup_menu_selection_callback,
+ − 808 popup_menu_down_callback);
+ − 809 free_popup_widget_value_tree (data);
+ − 810
+ − 811 gcpro_popup_callbacks (menu_id);
+ − 812
+ − 813 /* Setting zmacs-region-stays is necessary here because executing a command
+ − 814 from a menu is really a two-command process: the first command (bound to
+ − 815 the button-click) simply pops up the menu, and returns. This causes a
+ − 816 sequence of magic-events (destined for the popup-menu widget) to begin.
+ − 817 Eventually, a menu item is selected, and a menu-event blip is pushed onto
+ − 818 the end of the input stream, which is then executed by the event loop.
+ − 819
+ − 820 So there are two command-events, with a bunch of magic-events between
+ − 821 them. We don't want the *first* command event to alter the state of the
+ − 822 region, so that the region can be available as an argument for the second
+ − 823 command.
442
+ − 824 */
428
+ − 825 if (zmacs_regions)
+ − 826 zmacs_region_stays = 1;
+ − 827
+ − 828 popup_up_p++;
+ − 829 lw_popup_menu (menu, &xev);
+ − 830 /* this speeds up display of pop-up menus */
+ − 831 XFlush (XtDisplay (parent));
+ − 832 }
+ − 833
+ − 834
442
+ − 835
+ − 836 #if defined(LWLIB_MENUBARS_LUCID)
+ − 837 static void
+ − 838 menu_move_up (void)
+ − 839 {
+ − 840 widget_value *current = lw_get_entries (False);
+ − 841 widget_value *entries = lw_get_entries (True);
+ − 842 widget_value *prev = NULL;
+ − 843
+ − 844 while (entries != current)
+ − 845 {
+ − 846 if (entries->name /*&& entries->enabled*/) prev = entries;
+ − 847 entries = entries->next;
+ − 848 assert (entries);
+ − 849 }
+ − 850
+ − 851 if (!prev)
+ − 852 /* move to last item */
+ − 853 {
+ − 854 while (entries->next)
+ − 855 {
+ − 856 if (entries->name /*&& entries->enabled*/) prev = entries;
+ − 857 entries = entries->next;
+ − 858 }
+ − 859 if (prev)
+ − 860 {
+ − 861 if (entries->name /*&& entries->enabled*/)
+ − 862 prev = entries;
+ − 863 }
+ − 864 else
+ − 865 {
+ − 866 /* no selectable items in this menu, pop up to previous level */
+ − 867 lw_pop_menu ();
+ − 868 return;
+ − 869 }
+ − 870 }
+ − 871 lw_set_item (prev);
+ − 872 }
+ − 873
+ − 874 static void
+ − 875 menu_move_down (void)
+ − 876 {
+ − 877 widget_value *current = lw_get_entries (False);
+ − 878 widget_value *new = current;
+ − 879
+ − 880 while (new->next)
+ − 881 {
+ − 882 new = new->next;
+ − 883 if (new->name /*&& new->enabled*/) break;
+ − 884 }
+ − 885
+ − 886 if (new==current||!(new->name/*||new->enabled*/))
+ − 887 {
+ − 888 new = lw_get_entries (True);
+ − 889 while (new!=current)
+ − 890 {
+ − 891 if (new->name /*&& new->enabled*/) break;
+ − 892 new = new->next;
+ − 893 }
+ − 894 if (new==current&&!(new->name /*|| new->enabled*/))
+ − 895 {
+ − 896 lw_pop_menu ();
+ − 897 return;
+ − 898 }
+ − 899 }
+ − 900
+ − 901 lw_set_item (new);
+ − 902 }
+ − 903
+ − 904 static void
+ − 905 menu_move_left (void)
+ − 906 {
+ − 907 int level = lw_menu_level ();
+ − 908 int l = level;
+ − 909 widget_value *current;
+ − 910
+ − 911 while (level-- >= 3)
+ − 912 lw_pop_menu ();
+ − 913
+ − 914 menu_move_up ();
+ − 915 current = lw_get_entries (False);
+ − 916 if (l > 2 && current->contents)
+ − 917 lw_push_menu (current->contents);
+ − 918 }
+ − 919
+ − 920 static void
+ − 921 menu_move_right (void)
+ − 922 {
+ − 923 int level = lw_menu_level ();
+ − 924 int l = level;
+ − 925 widget_value *current;
+ − 926
+ − 927 while (level-- >= 3)
+ − 928 lw_pop_menu ();
+ − 929
+ − 930 menu_move_down ();
+ − 931 current = lw_get_entries (False);
+ − 932 if (l > 2 && current->contents)
+ − 933 lw_push_menu (current->contents);
+ − 934 }
+ − 935
+ − 936 static void
+ − 937 menu_select_item (widget_value *val)
+ − 938 {
+ − 939 if (val == NULL)
+ − 940 val = lw_get_entries (False);
+ − 941
+ − 942 /* is match a submenu? */
+ − 943
+ − 944 if (val->contents)
+ − 945 {
+ − 946 /* enter the submenu */
+ − 947
+ − 948 lw_set_item (val);
+ − 949 lw_push_menu (val->contents);
+ − 950 }
+ − 951 else
+ − 952 {
+ − 953 /* Execute the menu entry by calling the menu's `select'
+ − 954 callback function
+ − 955 */
+ − 956 lw_kill_menus (val);
+ − 957 }
+ − 958 }
+ − 959
+ − 960 Lisp_Object
+ − 961 command_builder_operate_menu_accelerator (struct command_builder *builder)
+ − 962 {
+ − 963 /* this function can GC */
+ − 964
+ − 965 struct console *con = XCONSOLE (Vselected_console);
+ − 966 Lisp_Object evee = builder->most_current_event;
+ − 967 Lisp_Object binding;
+ − 968 widget_value *entries;
+ − 969
+ − 970 extern int lw_menu_accelerate; /* lwlib.c */
+ − 971
+ − 972 #if 0
+ − 973 {
+ − 974 int i;
+ − 975 Lisp_Object t;
+ − 976
+ − 977 t = builder->current_events;
+ − 978 i = 0;
+ − 979 while (!NILP (t))
+ − 980 {
+ − 981 i++;
800
+ − 982 write_fmt_string (Qexternal_debugging_output, "OPERATE (%d): ",i);
442
+ − 983 print_internal (t, Qexternal_debugging_output, 1);
826
+ − 984 write_c_string (Qexternal_debugging_output, "\n");
442
+ − 985 t = XEVENT_NEXT (t);
+ − 986 }
+ − 987 }
+ − 988 #endif /* 0 */
+ − 989
+ − 990 /* menu accelerator keys don't go into keyboard macros */
+ − 991 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
+ − 992 con->kbd_macro_ptr = con->kbd_macro_end;
+ − 993
+ − 994 /* don't echo menu accelerator keys */
+ − 995 /*reset_key_echo (builder, 1);*/
+ − 996
+ − 997 if (!lw_menu_accelerate)
+ − 998 {
+ − 999 /* `convert' mouse display to keyboard display
+ − 1000 by entering the open submenu
+ − 1001 */
+ − 1002 entries = lw_get_entries (False);
+ − 1003 if (entries->contents)
+ − 1004 {
+ − 1005 lw_push_menu (entries->contents);
+ − 1006 lw_display_menu (CurrentTime);
+ − 1007 }
+ − 1008 }
+ − 1009
+ − 1010 /* compare event to the current menu accelerators */
+ − 1011
+ − 1012 entries=lw_get_entries (True);
+ − 1013
+ − 1014 while (entries)
+ − 1015 {
+ − 1016 Lisp_Object accel;
826
+ − 1017 accel = VOID_TO_LISP (entries->accel);
442
+ − 1018 if (entries->name && !NILP (accel))
+ − 1019 {
1204
+ − 1020 if (event_matches_key_specifier_p (evee, accel))
442
+ − 1021 {
+ − 1022 /* a match! */
+ − 1023
+ − 1024 menu_select_item (entries);
+ − 1025
+ − 1026 if (lw_menu_active) lw_display_menu (CurrentTime);
+ − 1027
+ − 1028 reset_this_command_keys (Vselected_console, 1);
+ − 1029 /*reset_command_builder_event_chain (builder);*/
+ − 1030 return Vmenu_accelerator_map;
+ − 1031 }
+ − 1032 }
+ − 1033 entries = entries->next;
+ − 1034 }
+ − 1035
+ − 1036 /* try to look up event in menu-accelerator-map */
+ − 1037
+ − 1038 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
+ − 1039
+ − 1040 if (NILP (binding))
+ − 1041 {
+ − 1042 /* beep at user for undefined key */
+ − 1043 return Qnil;
+ − 1044 }
+ − 1045 else
+ − 1046 {
+ − 1047 if (EQ (binding, Qmenu_quit))
+ − 1048 {
+ − 1049 /* turn off menus and set quit flag */
+ − 1050 lw_kill_menus (NULL);
+ − 1051 Vquit_flag = Qt;
+ − 1052 }
+ − 1053 else if (EQ (binding, Qmenu_up))
+ − 1054 {
+ − 1055 int level = lw_menu_level ();
+ − 1056 if (level > 2)
+ − 1057 menu_move_up ();
+ − 1058 }
+ − 1059 else if (EQ (binding, Qmenu_down))
+ − 1060 {
+ − 1061 int level = lw_menu_level ();
+ − 1062 if (level > 2)
+ − 1063 menu_move_down ();
+ − 1064 else
+ − 1065 menu_select_item (NULL);
+ − 1066 }
+ − 1067 else if (EQ (binding, Qmenu_left))
+ − 1068 {
+ − 1069 int level = lw_menu_level ();
+ − 1070 if (level > 3)
+ − 1071 {
+ − 1072 lw_pop_menu ();
+ − 1073 lw_display_menu (CurrentTime);
+ − 1074 }
+ − 1075 else
+ − 1076 menu_move_left ();
+ − 1077 }
+ − 1078 else if (EQ (binding, Qmenu_right))
+ − 1079 {
+ − 1080 int level = lw_menu_level ();
+ − 1081 if (level > 2 &&
+ − 1082 lw_get_entries (False)->contents)
+ − 1083 {
+ − 1084 widget_value *current = lw_get_entries (False);
+ − 1085 if (current->contents)
+ − 1086 menu_select_item (NULL);
+ − 1087 }
+ − 1088 else
+ − 1089 menu_move_right ();
+ − 1090 }
+ − 1091 else if (EQ (binding, Qmenu_select))
+ − 1092 menu_select_item (NULL);
+ − 1093 else if (EQ (binding, Qmenu_escape))
+ − 1094 {
+ − 1095 int level = lw_menu_level ();
+ − 1096
+ − 1097 if (level > 2)
+ − 1098 {
+ − 1099 lw_pop_menu ();
+ − 1100 lw_display_menu (CurrentTime);
+ − 1101 }
+ − 1102 else
+ − 1103 {
+ − 1104 /* turn off menus quietly */
+ − 1105 lw_kill_menus (NULL);
+ − 1106 }
+ − 1107 }
+ − 1108 else if (KEYMAPP (binding))
+ − 1109 {
+ − 1110 /* prefix key */
+ − 1111 reset_this_command_keys (Vselected_console, 1);
+ − 1112 /*reset_command_builder_event_chain (builder);*/
+ − 1113 return binding;
+ − 1114 }
+ − 1115 else
+ − 1116 {
+ − 1117 /* turn off menus and execute binding */
+ − 1118 lw_kill_menus (NULL);
+ − 1119 reset_this_command_keys (Vselected_console, 1);
+ − 1120 /*reset_command_builder_event_chain (builder);*/
+ − 1121 return binding;
+ − 1122 }
+ − 1123 }
+ − 1124
+ − 1125 if (lw_menu_active) lw_display_menu (CurrentTime);
+ − 1126
+ − 1127 reset_this_command_keys (Vselected_console, 1);
+ − 1128 /*reset_command_builder_event_chain (builder);*/
+ − 1129
+ − 1130 return Vmenu_accelerator_map;
+ − 1131 }
+ − 1132
+ − 1133 static Lisp_Object
+ − 1134 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
+ − 1135 {
+ − 1136 Vmenu_accelerator_prefix = Qnil;
+ − 1137 Vmenu_accelerator_modifiers = Qnil;
+ − 1138 Vmenu_accelerator_enabled = Qnil;
+ − 1139 if (!NILP (errordata))
+ − 1140 {
+ − 1141 /* #### This should call
+ − 1142 (with-output-to-string (display-error errordata))
+ − 1143 but that stuff is all in Lisp currently. */
+ − 1144 warn_when_safe_lispobj
+ − 1145 (Qerror, Qwarning,
771
+ − 1146 emacs_sprintf_string_lisp
+ − 1147 ("%s: %s", Qnil, 2,
+ − 1148 build_msg_string ("Error in menu accelerators (setting to nil)"),
+ − 1149 errordata));
442
+ − 1150 }
+ − 1151
+ − 1152 return Qnil;
+ − 1153 }
+ − 1154
+ − 1155 static Lisp_Object
+ − 1156 menu_accelerator_safe_compare (Lisp_Object event0)
+ − 1157 {
+ − 1158 if (CONSP (Vmenu_accelerator_prefix))
+ − 1159 {
+ − 1160 Lisp_Object t;
+ − 1161 t=Vmenu_accelerator_prefix;
+ − 1162 while (!NILP (t)
+ − 1163 && !NILP (event0)
1204
+ − 1164 && event_matches_key_specifier_p (event0, Fcar (t)))
442
+ − 1165 {
+ − 1166 t = Fcdr (t);
+ − 1167 event0 = XEVENT_NEXT (event0);
+ − 1168 }
+ − 1169 if (!NILP (t))
+ − 1170 return Qnil;
+ − 1171 }
+ − 1172 else if (NILP (event0))
+ − 1173 return Qnil;
1204
+ − 1174 else if (event_matches_key_specifier_p (event0, Vmenu_accelerator_prefix))
442
+ − 1175 event0 = XEVENT_NEXT (event0);
+ − 1176 else
+ − 1177 return Qnil;
+ − 1178 return event0;
+ − 1179 }
+ − 1180
+ − 1181 static Lisp_Object
+ − 1182 menu_accelerator_safe_mod_compare (Lisp_Object cons)
+ − 1183 {
1204
+ − 1184 return (event_matches_key_specifier_p (XCAR (cons), XCDR (cons)) ? Qt
442
+ − 1185 : Qnil);
+ − 1186 }
+ − 1187
+ − 1188 Lisp_Object
+ − 1189 command_builder_find_menu_accelerator (struct command_builder *builder)
+ − 1190 {
+ − 1191 /* this function can GC */
+ − 1192 Lisp_Object event0 = builder->current_events;
+ − 1193 struct console *con = XCONSOLE (Vselected_console);
+ − 1194 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
+ − 1195 Widget menubar_widget;
+ − 1196
+ − 1197 /* compare entries in event0 against the menu prefix */
+ − 1198
+ − 1199 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
+ − 1200 XEVENT (event0)->event_type != key_press_event)
+ − 1201 return Qnil;
+ − 1202
+ − 1203 if (!NILP (Vmenu_accelerator_prefix))
+ − 1204 {
+ − 1205 event0 = condition_case_1 (Qerror,
+ − 1206 menu_accelerator_safe_compare,
+ − 1207 event0,
+ − 1208 menu_accelerator_junk_on_error,
+ − 1209 Qnil);
+ − 1210 }
+ − 1211
+ − 1212 if (NILP (event0))
+ − 1213 return Qnil;
+ − 1214
+ − 1215 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
+ − 1216 if (menubar_widget
+ − 1217 && CONSP (Vmenu_accelerator_modifiers))
+ − 1218 {
446
+ − 1219 Lisp_Object fake = Qnil;
442
+ − 1220 Lisp_Object last = Qnil;
+ − 1221 struct gcpro gcpro1;
+ − 1222 Lisp_Object matchp;
+ − 1223
+ − 1224 widget_value *val;
1346
+ − 1225 LWLIB_ID id = FRAME_X_MENUBAR_ID (f);
442
+ − 1226
+ − 1227 val = lw_get_all_values (id);
+ − 1228 if (val)
+ − 1229 {
+ − 1230 val = val->contents;
+ − 1231
+ − 1232 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
+ − 1233 last = fake;
+ − 1234
+ − 1235 while (!NILP (Fcdr (last)))
+ − 1236 last = Fcdr (last);
+ − 1237
+ − 1238 Fsetcdr (last, Fcons (Qnil, Qnil));
+ − 1239 last = Fcdr (last);
+ − 1240 }
+ − 1241
+ − 1242 fake = Fcons (Qnil, fake);
+ − 1243
+ − 1244 GCPRO1 (fake);
+ − 1245
+ − 1246 while (val)
+ − 1247 {
+ − 1248 Lisp_Object accel;
826
+ − 1249 accel = VOID_TO_LISP (val->accel);
442
+ − 1250 if (val->name && !NILP (accel))
+ − 1251 {
+ − 1252 Fsetcar (last, accel);
+ − 1253 Fsetcar (fake, event0);
+ − 1254 matchp = condition_case_1 (Qerror,
+ − 1255 menu_accelerator_safe_mod_compare,
+ − 1256 fake,
+ − 1257 menu_accelerator_junk_on_error,
+ − 1258 Qnil);
+ − 1259 if (!NILP (matchp))
+ − 1260 {
+ − 1261 /* we found one! */
+ − 1262
+ − 1263 lw_set_menu (menubar_widget, val);
+ − 1264 /* yah - yet another hack.
+ − 1265 pretend emacs timestamp is the same as an X timestamp,
+ − 1266 which for the moment it is. (read events.h)
+ − 1267 */
+ − 1268 lw_map_menu (XEVENT (event0)->timestamp);
+ − 1269
+ − 1270 if (val->contents)
+ − 1271 lw_push_menu (val->contents);
+ − 1272
+ − 1273 lw_display_menu (CurrentTime);
+ − 1274
+ − 1275 /* menu accelerator keys don't go into keyboard macros */
+ − 1276 if (!NILP (con->defining_kbd_macro)
+ − 1277 && NILP (Vexecuting_macro))
+ − 1278 con->kbd_macro_ptr = con->kbd_macro_end;
+ − 1279
+ − 1280 /* don't echo menu accelerator keys */
+ − 1281 /*reset_key_echo (builder, 1);*/
+ − 1282 reset_this_command_keys (Vselected_console, 1);
+ − 1283 UNGCPRO;
+ − 1284
+ − 1285 return Vmenu_accelerator_map;
+ − 1286 }
+ − 1287 }
+ − 1288
+ − 1289 val = val->next;
+ − 1290 }
+ − 1291
+ − 1292 UNGCPRO;
+ − 1293 }
+ − 1294 return Qnil;
+ − 1295 }
+ − 1296
+ − 1297 int
+ − 1298 x_kludge_lw_menu_active (void)
+ − 1299 {
+ − 1300 return lw_menu_active;
+ − 1301 }
+ − 1302
+ − 1303 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
+ − 1304 Make the menubar active. Menu items can be selected using menu accelerators
+ − 1305 or by actions defined in menu-accelerator-map.
+ − 1306 */
+ − 1307 ())
+ − 1308 {
+ − 1309 struct console *con = XCONSOLE (Vselected_console);
+ − 1310 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
+ − 1311 LWLIB_ID id;
+ − 1312 widget_value *val;
+ − 1313
1346
+ − 1314 if (!FRAME_X_MENUBAR_ID (f))
563
+ − 1315 invalid_argument ("Frame has no menubar", Qunbound);
442
+ − 1316
1346
+ − 1317 id = FRAME_X_MENUBAR_ID (f);
442
+ − 1318 val = lw_get_all_values (id);
+ − 1319 val = val->contents;
+ − 1320 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
+ − 1321 lw_map_menu (CurrentTime);
+ − 1322
+ − 1323 lw_display_menu (CurrentTime);
+ − 1324
+ − 1325 /* menu accelerator keys don't go into keyboard macros */
+ − 1326 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
+ − 1327 con->kbd_macro_ptr = con->kbd_macro_end;
+ − 1328
+ − 1329 return Qnil;
+ − 1330 }
+ − 1331 #endif /* LWLIB_MENUBARS_LUCID */
+ − 1332
+ − 1333
428
+ − 1334 void
+ − 1335 syms_of_menubar_x (void)
+ − 1336 {
442
+ − 1337 #if defined(LWLIB_MENUBARS_LUCID)
+ − 1338 DEFSUBR (Faccelerate_menu);
+ − 1339 #endif
428
+ − 1340 }
+ − 1341
+ − 1342 void
+ − 1343 console_type_create_menubar_x (void)
+ − 1344 {
+ − 1345 CONSOLE_HAS_METHOD (x, update_frame_menubars);
+ − 1346 CONSOLE_HAS_METHOD (x, free_frame_menubars);
+ − 1347 CONSOLE_HAS_METHOD (x, popup_menu);
+ − 1348 }
+ − 1349
+ − 1350 void
+ − 1351 reinit_vars_of_menubar_x (void)
+ − 1352 {
+ − 1353 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
+ − 1354 }
+ − 1355
+ − 1356 void
+ − 1357 vars_of_menubar_x (void)
+ − 1358 {
+ − 1359 reinit_vars_of_menubar_x ();
+ − 1360
+ − 1361 #if defined (LWLIB_MENUBARS_LUCID)
+ − 1362 Fprovide (intern ("lucid-menubars"));
+ − 1363 #elif defined (LWLIB_MENUBARS_MOTIF)
+ − 1364 Fprovide (intern ("motif-menubars"));
+ − 1365 #elif defined (LWLIB_MENUBARS_ATHENA)
+ − 1366 Fprovide (intern ("athena-menubars"));
+ − 1367 #endif
+ − 1368 }