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