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