Mercurial > hg > xemacs-beta
view src/menubar-x.c @ 826:6728e641994e
[xemacs-hg @ 2002-05-05 11:30:15 by ben]
syntax cache, 8-bit-format, lots of code cleanup
README.packages: Update info about --package-path.
i.c: Create an inheritable event and pass it on to XEmacs, so that ^C
can be handled properly. Intercept ^C and signal the event.
"Stop Build" in VC++ now works.
bytecomp-runtime.el: Doc string changes.
compat.el: Some attempts to redo this to
make it truly useful and fix the "multiple versions interacting
with each other" problem. Not yet done. Currently doesn't work.
files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code.
xemacs.mak: Split up CFLAGS into a version without flags specifying the C
library. The problem seems to be that minitar depends on zlib,
which depends specifically on libc.lib, not on any of the other C
libraries. Unless you compile with libc.lib, you get errors --
specifically, no _errno in the other libraries, which must make it
something other than an int. (#### But this doesn't seem to obtain
in XEmacs, which also uses zlib, and can be linked with any of the
C libraries. Maybe zlib is used differently and doesn't need
errno, or maybe XEmacs provides an int errno; ... I don't
understand.
Makefile.in.in: Fix so that packages are around when testing.
abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch.
-- FUNCTIONALITY CHANGES:
add partial support for 8-bit-fixed, 16-bit-fixed, and
32-bit-fixed formats. not quite done yet. (in particular, needs
functions to actually convert the buffer.) NOTE: lots of changes
to regex.c here. also, many new *_fmt() inline funs that take an
Internal_Format argument.
redo syntax cache code. make the cache per-buffer; keep the cache
valid across calls to functions that use it. also keep it valid
across insertions/deletions and extent changes, as much as is
possible. eliminate the junky regex-reentrancy code by passing in
the relevant lisp info to the regex routines as local vars.
add general mechanism in extents code for signalling extent changes.
fix numerous problems with the case-table implementation; yoshiki
never properly transferred many algorithms from old-style to
new-style case tables.
redo char tables to support a default argument, so that mapping
only occurs over changed args. change many chartab functions to
accept Lisp_Object instead of Lisp_Char_Table *.
comment out the code in font-lock.c by default, because
font-lock.el no longer uses it. we should consider eliminating it
entirely.
Don't output bell as ^G in console-stream when not a TTY.
add -mswindows-termination-handle to interface with i.c, so we can
properly kill a build.
add more error-checking to buffer/string macros.
add some additional buffer_or_string_() funs.
-- INTERFACE CHANGES AFFECTING MORE CODE:
switch the arguments of write_c_string and friends to be
consistent with write_fmt_string, which must have printcharfun
first.
change BI_* macros to BYTE_* for increased clarity; similarly for
bi_* local vars.
change VOID_TO_LISP to be a one-argument function. eliminate
no-longer-needed CVOID_TO_LISP.
-- char/string macro changes:
rename MAKE_CHAR() to make_emchar() for slightly less confusion
with make_char(). (The former generates an Emchar, the latter a
Lisp object. Conceivably we should rename make_char() -> wrap_char()
and similarly for make_int(), make_float().)
Similar changes for other *CHAR* macros -- we now consistently use
names with `emchar' whenever we are working with Emchars. Any
remaining name with just `char' always refers to a Lisp object.
rename macros with XSTRING_* to string_* except for those that
reference actual fields in the Lisp_String object, following
conventions used elsewhere.
rename set_string_{data,length} macros (the only ones to work with
a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_*
to make the difference clear.
try to be consistent about caps vs. lowercase in macro/inline-fun
names for chars and such, which wasn't the case before. we now
reserve caps either for XFOO_ macros that reference object fields
(e.g. XSTRING_DATA) or for things that have non-function semantics,
e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an
arg (any arg) more than once. otherwise, use lowercase.
here is a summary of most of the macros/inline funs changed by all
of the above changes:
BYTE_*_P -> byte_*_p
XSTRING_BYTE -> string_byte
set_string_data/length -> set_lispstringp_data/length
XSTRING_CHAR_LENGTH -> string_char_length
XSTRING_CHAR -> string_emchar
INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p
INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p
charptr_copy_char -> charptr_copy_emchar
LEADING_BYTE_* -> leading_byte_*
CHAR_* -> EMCHAR_*
*_CHAR_* -> *_EMCHAR_*
*_CHAR -> *_EMCHAR
CHARSET_BY_ -> charset_by_*
BYTE_SHIFT_JIS* -> byte_shift_jis*
BYTE_BIG5* -> byte_big5*
REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte
char_to_unicode -> emchar_to_unicode
valid_char_p -> valid_emchar_p
Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality).
-- INTERFACE CHANGES AFFECTING LESS CODE:
use DECLARE_INLINE_HEADER in various places.
remove '#ifdef emacs' from XEmacs-only files.
eliminate CHAR_TABLE_VALUE(), which duplicated the functionality
of get_char_table().
add BUFFER_TEXT_LOOP to simplify iterations over buffer text.
define typedefs for signed and unsigned types of fixed sizes
(INT_32_BIT, UINT_32_BIT, etc.).
create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE;
fix code to use it.
add charptr_emchar_len to return the text length of the character
pointed to by a ptr; use it in place of
charcount_to_bytecount(..., 1). add emchar_len to return the text
length of a given character.
add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount
and Charbpos/Charcount, in code (particularly, the extents code
and redisplay code) that works with either kind of index. rename
redisplay struct params with names such as `charbpos' to
e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos.
eliminate xxDEFUN in place of DEFUN; no longer necessary with
changes awhile back to doc.c.
split up big ugly combined list of EXFUNs in lisp.h on a
file-by-file basis, since other prototypes are similarly split.
rewrite some "*_UNSAFE" macros as inline funs and eliminate the
_UNSAFE suffix.
move most string code from lisp.h to text.h; the string code and
text.h code is now intertwined in such a fashion that they need
to be in the same place and partially interleaved. (you can't
create forward references for inline funs)
automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in
batch mode.
Fix up some problems in lisp-tests/symbol-tests that were
causing spurious failures.
author | ben |
---|---|
date | Sun, 05 May 2002 11:33:57 +0000 |
parents | a5954632b187 |
children | 2b6fa2618f76 |
line wrap: on
line source
/* Implements an elisp-programmable menubar -- X interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. Copyright (C) 2000, 2001 ,2002 Ben Wing. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ /* This file Mule-ized by Ben Wing, 7-8-00. */ /* Authorship: Created 16-dec-91 by Jamie Zawinski. Menu filters and many other keywords added by Stig for 19.12. Original device-abstraction work and GC cleanup work by Ben Wing for 19.13. Menu accelerators c. 1997? by ??. Moved here from event-stream.c. Other work post-1996 by ??. */ #include <config.h> #include "lisp.h" #include "buffer.h" #include "commands.h" /* zmacs_regions */ #include "device.h" #include "events.h" #include "frame.h" #include "gui.h" #include "keymap.h" #include "menubar.h" #include "opaque.h" #include "window.h" #include "console-x.h" #include "gui-x.h" #include "EmacsFrame.h" #include "../lwlib/lwlib.h" static int set_frame_menubar (struct frame *f, int deep_p, int first_time_p); #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data) #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data) #define MENUBAR_TYPE 0 #define SUBMENU_TYPE 1 #define POPUP_TYPE 2 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form. menu_item_descriptor_to_widget_value() converts a lisp description of a menubar into a tree of widget_value structures. It allocates widget_values with malloc_widget_value() and allocates other storage only for the `key' slot. All other slots are filled with pointers to Lisp_String data. We allocate a widget_value description of the menu or menubar, and hand it to lwlib, which then makes a copy of it, which it manages internally. We then immediately free our widget_value tree; it will not be referenced again. Incremental menu construction callbacks operate just a bit differently. They allocate widget_values and call replace_widget_value_tree() to tell lwlib to destructively modify the incremental stub (subtree) of its separate widget_value tree. This function is highly recursive (it follows the menu trees) and may call eval. The reason we keep pointers to lisp string data instead of copying it and freeing it later is to avoid the speed penalty that would entail (since this needs to be fast, in the simple cases at least). (The reason we malloc/free the keys slot is because there's not a lisp string around for us to use in that case.) Since we keep pointers to lisp strings, and we call eval, we could lose if GC relocates (or frees) those strings. It's not easy to gc protect the strings because of the recursive nature of this function, and the fact that it returns a data structure that gets freed later. So... we do the sleaziest thing possible and inhibit GC for the duration. This is probably not a big deal... We do not have to worry about the pointers to Lisp_String data after this function successfully finishes. lwlib copies all such data with strdup(). */ static widget_value * menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, int menu_type, int deep_p, int filter_p, int depth) { /* This function cannot GC. It is only called from menu_item_descriptor_to_widget_value, which prohibits GC. */ int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0); int count = specpdl_depth (); int partition_seen = 0; widget_value *wv = xmalloc_widget_value (); Lisp_Object wv_closure = make_opaque_ptr (wv); record_unwind_protect (widget_value_unwind, wv_closure); if (STRINGP (desc)) { Intbyte *string_chars = XSTRING_DATA (desc); wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE : TEXT_TYPE); if (wv->type == SEPARATOR_TYPE) { wv->value = menu_separator_style_and_to_external (string_chars); } else { LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding); wv->enabled = 1; /* dverna Dec. 98: command_builder_operate_menu_accelerator will manipulate the accel as a Lisp_Object if the widget has a name. Since simple labels have a name, but no accel, we *must* set it to nil */ wv->accel = LISP_TO_VOID (Qnil); } } else if (VECTORP (desc)) { Lisp_Object gui_item = gui_parse_item_keywords (desc); if (!button_item_to_widget_value (Qmenubar, gui_item, wv, 1, (menu_type == MENUBAR_TYPE && depth <= 1), 1, 1)) { /* :included form was nil */ wv = NULL; goto menu_item_done; } } else if (CONSP (desc)) { Lisp_Object incremental_data = desc; widget_value *prev = 0; if (STRINGP (XCAR (desc))) { Lisp_Object key, val; Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; Lisp_Object active_p = Qt; Lisp_Object accel; int included_spec = 0; int active_spec = 0; wv->type = CASCADE_TYPE; wv->enabled = 1; wv->name = add_accel_and_to_external (XCAR (desc)); accel = gui_name_accelerator (XCAR (desc)); wv->accel = LISP_TO_VOID (accel); desc = Fcdr (desc); while (key = Fcar (desc), KEYWORDP (key)) { Lisp_Object cascade = desc; desc = Fcdr (desc); if (NILP (desc)) sferror ("Keyword in menu lacks a value", cascade); val = Fcar (desc); desc = Fcdr (desc); if (EQ (key, Q_included)) include_p = val, included_spec = 1; else if (EQ (key, Q_config)) config_tag = val; else if (EQ (key, Q_filter)) hook_fn = val; else if (EQ (key, Q_active)) active_p = val, active_spec = 1; else if (EQ (key, Q_accelerator)) { if ( SYMBOLP (val) || CHARP (val)) wv->accel = LISP_TO_VOID (val); else invalid_argument ("bad keyboard accelerator", val); } else if (EQ (key, Q_label)) { /* implement in 21.2 */ } else invalid_argument ("Unknown menu cascade keyword", cascade); } if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) || (included_spec && NILP (Feval (include_p)))) { wv = NULL; goto menu_item_done; } if (active_spec) active_p = Feval (active_p); if (!NILP (hook_fn) && !NILP (active_p)) { #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF if (filter_p || depth == 0) { #endif desc = call1_trapping_errors ("Error in menubar filter", hook_fn, desc); if (UNBOUNDP (desc)) desc = Qnil; #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF } else { widget_value *incr_wv = xmalloc_widget_value (); wv->contents = incr_wv; incr_wv->type = INCREMENTAL_TYPE; incr_wv->enabled = 1; incr_wv->name = wv->name; incr_wv->name = xstrdup (wv->name); /* This is automatically GC protected through the call to lw_map_widget_values(); no need to worry. */ incr_wv->call_data = LISP_TO_VOID (incremental_data); goto menu_item_done; } #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ } if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0) { /* Simply prepend three more widget values to the contents of the menu: a label, and two separators (to get a double line). */ widget_value *title_wv = xmalloc_widget_value (); widget_value *sep_wv = xmalloc_widget_value (); title_wv->type = TEXT_TYPE; title_wv->name = xstrdup (wv->name); title_wv->enabled = 1; title_wv->next = sep_wv; sep_wv->type = SEPARATOR_TYPE; sep_wv->value = menu_separator_style_and_to_external ((Intbyte *) "=="); sep_wv->next = 0; wv->contents = title_wv; prev = sep_wv; } wv->enabled = ! NILP (active_p); if (deep_p && !wv->enabled && !NILP (desc)) { widget_value *dummy; /* Add a fake entry so the menus show up */ wv->contents = dummy = xmalloc_widget_value (); dummy->name = xstrdup ("(inactive)"); dummy->accel = LISP_TO_VOID (Qnil); dummy->enabled = 0; dummy->selected = 0; dummy->value = NULL; dummy->type = BUTTON_TYPE; dummy->call_data = NULL; dummy->next = NULL; goto menu_item_done; } } else if (menubar_root_p) { wv->name = xstrdup ("menubar"); wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and this is ignored anyway... */ } else { sferror ("Menu name (first element) must be a string", desc); } if (deep_p || menubar_root_p) { widget_value *next; for (; !NILP (desc); desc = Fcdr (desc)) { Lisp_Object child = Fcar (desc); if (menubar_root_p && NILP (child)) /* the partition */ { if (partition_seen) sferror ("More than one partition (nil) in menubar description", desc); partition_seen = 1; next = xmalloc_widget_value (); next->type = PUSHRIGHT_TYPE; } else { next = menu_item_descriptor_to_widget_value_1 (child, menu_type, deep_p, filter_p, depth + 1); } if (! next) continue; else if (prev) prev->next = next; else wv->contents = next; prev = next; } } if (deep_p && !wv->contents) wv = NULL; } else if (NILP (desc)) sferror ("nil may not appear in menu descriptions", desc); else sferror ("Unrecognized menu descriptor", desc); menu_item_done: if (wv) { /* Completed normally. Clear out the object that widget_value_unwind() will be called with to tell it not to free the wv (as we are returning it.) */ set_opaque_ptr (wv_closure, 0); } unbind_to (count); return wv; } static widget_value * menu_item_descriptor_to_widget_value (Lisp_Object desc, int menu_type, /* if this is a menubar, popup or sub menu */ int deep_p, /* */ int filter_p) /* if :filter forms should run now */ { widget_value *wv; int count = begin_gc_forbidden (); /* Can't GC! */ wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p, filter_p, 0); unbind_to (count); return wv; } #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF int in_menu_callback; static Lisp_Object restore_in_menu_callback (Lisp_Object val) { in_menu_callback = XINT (val); return Qnil; } #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ #if 0 /* #### Sort of a hack needed to process Vactivate_menubar_hook correctly wrt buffer-local values. A correct solution would involve adding a callback mechanism to run_hook(). This function is currently unused. */ static int my_run_hook (Lisp_Object hooksym, int allow_global_p) { /* This function can GC */ Lisp_Object tail; Lisp_Object value = Fsymbol_value (hooksym); int changes = 0; if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda))) return !EQ (call0 (value), Qt); EXTERNAL_LIST_LOOP (tail, value) { if (allow_global_p && EQ (XCAR (tail), Qt)) changes |= my_run_hook (Fdefault_value (hooksym), 0); if (!EQ (call0 (XCAR (tail)), Qt)) changes = 1; } return changes; } #endif /* The order in which callbacks are run is funny to say the least. It's sometimes tricky to avoid running a callback twice, and to avoid returning prematurely. So, this function returns true if the menu's callbacks are no longer gc protected. So long as we unprotect them before allowing other callbacks to run, everything should be ok. The pre_activate_callback() *IS* intentionally called multiple times. If client_data == NULL, then it's being called before the menu is posted. If client_data != NULL, then client_data is a (widget_value *) and client_data->data is a Lisp_Object pointing to a lisp submenu description that must be converted into widget_values. *client_data is destructively modified. #### Stig thinks that there may be a GC problem here due to the fact that pre_activate_callback() is called multiple times, but I think he's wrong. */ static void pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) { /* This function can GC */ struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); Lisp_Object frame; int count; /* set in lwlib to the time stamp associated with the most recent menu operation */ extern Time x_focus_timestamp_really_sucks_fix_me_better; if (!f) f = x_any_window_to_frame (d, XtWindow (XtParent (widget))); if (!f) return; /* make sure f is the selected frame */ frame = wrap_frame (f); Fselect_frame (frame); if (client_data) { /* this is an incremental menu construction callback */ widget_value *hack_wv = (widget_value *) client_data; Lisp_Object submenu_desc; widget_value *wv; assert (hack_wv->type == INCREMENTAL_TYPE); submenu_desc = VOID_TO_LISP (hack_wv->call_data); /* * #### Fix the menu code so this isn't necessary. * * Protect against reentering the menu code otherwise we will * crash later when the code gets confused at the state * changes. */ count = specpdl_depth (); record_unwind_protect (restore_in_menu_callback, make_int (in_menu_callback)); in_menu_callback = 1; wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, 1, 0); unbind_to (count); if (!wv) { wv = xmalloc_widget_value (); wv->type = CASCADE_TYPE; wv->next = NULL; wv->accel = LISP_TO_VOID (Qnil); wv->contents = xmalloc_widget_value (); wv->contents->type = TEXT_TYPE; wv->contents->name = xstrdup ("No menu"); wv->contents->next = NULL; wv->contents->accel = LISP_TO_VOID (Qnil); } assert (wv && wv->type == CASCADE_TYPE && wv->contents); replace_widget_value_tree (hack_wv, wv->contents); free_popup_widget_value_tree (wv); } else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f))) return; else { #if 0 /* Unused, see comment below. */ int any_changes; /* #### - this menubar update mechanism is expensively anti-social and the activate-menubar-hook is now mostly obsolete. */ any_changes = my_run_hook (Qactivate_menubar_hook, 1); /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that incremental menus are implemented. If a subtree of a menu has been updated incrementally (a destructive operation), then that subtree must somehow be wiped. It is difficult to undo the destructive operation in lwlib because a pointer back to lisp data needs to be hidden away somewhere. So that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */ if (any_changes || !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date) set_frame_menubar (f, 1, 0); #else run_hook (Qactivate_menubar_hook); set_frame_menubar (f, 1, 0); #endif DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = x_focus_timestamp_really_sucks_fix_me_better; } } static widget_value * compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p) { if (NILP (menubar)) return 0; else { widget_value *data; int count = specpdl_depth (); record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE, deep_p, 0); unbind_to (count); return data; } } static int set_frame_menubar (struct frame *f, int deep_p, int first_time_p) { widget_value *data; Lisp_Object menubar; int menubar_visible; long id; /* As with the toolbar, the minibuffer does not have its own menubar. */ struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); if (! FRAME_X_P (f)) return 0; /***** first compute the contents of the menubar *****/ if (! first_time_p) { /* evaluate `current-menubar' in the buffer of the selected window of the frame in question. */ menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer); } else { /* That's a little tricky the first time since the frame isn't fully initialized yet. */ menubar = Fsymbol_value (Qcurrent_menubar); } if (NILP (menubar)) { menubar = Vblank_menubar; menubar_visible = 0; } else menubar_visible = !NILP (w->menubar_visible_p); data = compute_menubar_data (f, menubar, deep_p); if (!data || (!data->next && !data->contents)) abort (); if (NILP (FRAME_MENUBAR_DATA (f))) { struct popup_data *mdata = alloc_lcrecord_type (struct popup_data, &lrecord_popup_data); mdata->id = new_lwlib_id (); mdata->last_menubar_buffer = Qnil; mdata->menubar_contents_up_to_date = 0; FRAME_MENUBAR_DATA (f) = wrap_popup_data (mdata); } /***** now store into the menubar widget, creating it if necessary *****/ id = XFRAME_MENUBAR_DATA (f)->id; if (!FRAME_X_MENUBAR_WIDGET (f)) { Widget parent = FRAME_X_CONTAINER_WIDGET (f); assert (first_time_p); /* It's the first time we've mapped the menubar so compute its contents completely once. This makes sure that the menubar components are created with the right type. */ if (!deep_p) { free_popup_widget_value_tree (data); data = compute_menubar_data (f, menubar, 1); } FRAME_X_MENUBAR_WIDGET (f) = lw_create_widget ("menubar", "menubar", id, data, parent, 0, pre_activate_callback, popup_selection_callback, 0); } else { lw_modify_all_widgets (id, data, deep_p ? True : False); } free_popup_widget_value_tree (data); XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p; XFRAME_MENUBAR_DATA (f)->last_menubar_buffer = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer; return menubar_visible; } /* Called from x_create_widgets() to create the initial menubar of a frame before it is mapped, so that the window is mapped with the menubar already there instead of us tacking it on later and thrashing the window after it is visible. */ int x_initialize_frame_menubar (struct frame *f) { return set_frame_menubar (f, 1, 1); } static LWLIB_ID last_popup_menu_selection_callback_id; static void popup_menu_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) { last_popup_menu_selection_callback_id = id; popup_selection_callback (widget, id, client_data); /* lw_destroy_all_widgets() will be called from popup_down_callback() */ } static void popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data) { if (popup_handled_p (id)) return; assert (popup_up_p != 0); ungcpro_popup_callbacks (id); popup_up_p--; /* if this isn't called immediately after the selection callback, then there wasn't a menu selection. */ if (id != last_popup_menu_selection_callback_id) popup_selection_callback (widget, id, (XtPointer) -1); lw_destroy_all_widgets (id); } static void make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev) /* NULL for eev means query pointer */ { XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy; btn->type = ButtonPress; btn->serial = 0; btn->send_event = 0; btn->display = XtDisplay (daddy); btn->window = XtWindow (daddy); if (eev) { Position shellx, shelly, framex, framey; Arg al [2]; btn->time = eev->timestamp; btn->button = eev->event.button.button; btn->root = RootWindowOfScreen (XtScreen (daddy)); btn->subwindow = (Window) NULL; btn->x = eev->event.button.x; btn->y = eev->event.button.y; shellx = shelly = 0; #ifndef HAVE_WMCOMMAND { Widget shell = XtParent (daddy); XtSetArg (al [0], XtNx, &shellx); XtSetArg (al [1], XtNy, &shelly); XtGetValues (shell, al, 2); } #endif XtSetArg (al [0], XtNx, &framex); XtSetArg (al [1], XtNy, &framey); XtGetValues (daddy, al, 2); btn->x_root = shellx + framex + btn->x; btn->y_root = shelly + framey + btn->y; btn->state = ButtonPressMask; /* all buttons pressed */ } else { /* CurrentTime is just ZERO, so it's worthless for determining relative click times. */ struct device *d = get_device_from_display (XtDisplay (daddy)); btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */ btn->button = 0; XQueryPointer (btn->display, btn->window, &btn->root, &btn->subwindow, &btn->x_root, &btn->y_root, &btn->x, &btn->y, &btn->state); } } static void x_update_frame_menubar_internal (struct frame *f) { /* We assume the menubar contents has changed if the global flag is set, or if the current buffer has changed, or if the menubar has never been updated before. */ int menubar_contents_changed = (f->menubar_changed || NILP (FRAME_MENUBAR_DATA (f)) || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer, XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer))); Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f)); Boolean menubar_will_be_visible = menubar_was_visible; Boolean menubar_visibility_changed; if (menubar_contents_changed) menubar_will_be_visible = set_frame_menubar (f, 0, 0); menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible; if (!menubar_visibility_changed) return; /* Set menubar visibility */ (menubar_will_be_visible ? XtManageChild : XtUnmanageChild) (FRAME_X_MENUBAR_WIDGET (f)); MARK_FRAME_SIZE_SLIPPED (f); } static void x_update_frame_menubars (struct frame *f) { assert (FRAME_X_P (f)); x_update_frame_menubar_internal (f); /* #### This isn't going to work right now that this function works on a per-frame, not per-device basis. Guess what? I don't care. */ } static void x_free_frame_menubars (struct frame *f) { Widget menubar_widget; assert (FRAME_X_P (f)); menubar_widget = FRAME_X_MENUBAR_WIDGET (f); if (menubar_widget) { LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id; lw_destroy_all_widgets (id); XFRAME_MENUBAR_DATA (f)->id = 0; } } static void x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) { int menu_id; struct frame *f = selected_frame (); widget_value *data; Widget parent; Widget menu; Lisp_Event *eev = NULL; XEvent xev; Lisp_Object frame = wrap_frame (f); CHECK_X_FRAME (frame); parent = FRAME_X_SHELL_WIDGET (f); if (!NILP (event)) { CHECK_LIVE_EVENT (event); eev= XEVENT (event); if (eev->event_type != button_press_event && eev->event_type != button_release_event) wrong_type_argument (Qmouse_event_p, event); } else if (!NILP (Vthis_command_keys)) { /* if an event wasn't passed, use the last event of the event sequence currently being executed, if that event is a mouse event */ eev = XEVENT (Vthis_command_keys); /* last event first */ if (eev->event_type != button_press_event && eev->event_type != button_release_event) eev = NULL; } make_dummy_xbutton_event (&xev, parent, eev); if (SYMBOLP (menu_desc)) menu_desc = Fsymbol_value (menu_desc); CHECK_CONS (menu_desc); CHECK_STRING (XCAR (menu_desc)); data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1); if (! data) signal_error (Qgui_error, "no menu", Qunbound); menu_id = new_lwlib_id (); menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data, parent, 1, 0, popup_menu_selection_callback, popup_menu_down_callback); free_popup_widget_value_tree (data); gcpro_popup_callbacks (menu_id); /* Setting zmacs-region-stays is necessary here because executing a command from a menu is really a two-command process: the first command (bound to the button-click) simply pops up the menu, and returns. This causes a sequence of magic-events (destined for the popup-menu widget) to begin. Eventually, a menu item is selected, and a menu-event blip is pushed onto the end of the input stream, which is then executed by the event loop. So there are two command-events, with a bunch of magic-events between them. We don't want the *first* command event to alter the state of the region, so that the region can be available as an argument for the second command. */ if (zmacs_regions) zmacs_region_stays = 1; popup_up_p++; lw_popup_menu (menu, &xev); /* this speeds up display of pop-up menus */ XFlush (XtDisplay (parent)); } #if defined(LWLIB_MENUBARS_LUCID) static void menu_move_up (void) { widget_value *current = lw_get_entries (False); widget_value *entries = lw_get_entries (True); widget_value *prev = NULL; while (entries != current) { if (entries->name /*&& entries->enabled*/) prev = entries; entries = entries->next; assert (entries); } if (!prev) /* move to last item */ { while (entries->next) { if (entries->name /*&& entries->enabled*/) prev = entries; entries = entries->next; } if (prev) { if (entries->name /*&& entries->enabled*/) prev = entries; } else { /* no selectable items in this menu, pop up to previous level */ lw_pop_menu (); return; } } lw_set_item (prev); } static void menu_move_down (void) { widget_value *current = lw_get_entries (False); widget_value *new = current; while (new->next) { new = new->next; if (new->name /*&& new->enabled*/) break; } if (new==current||!(new->name/*||new->enabled*/)) { new = lw_get_entries (True); while (new!=current) { if (new->name /*&& new->enabled*/) break; new = new->next; } if (new==current&&!(new->name /*|| new->enabled*/)) { lw_pop_menu (); return; } } lw_set_item (new); } static void menu_move_left (void) { int level = lw_menu_level (); int l = level; widget_value *current; while (level-- >= 3) lw_pop_menu (); menu_move_up (); current = lw_get_entries (False); if (l > 2 && current->contents) lw_push_menu (current->contents); } static void menu_move_right (void) { int level = lw_menu_level (); int l = level; widget_value *current; while (level-- >= 3) lw_pop_menu (); menu_move_down (); current = lw_get_entries (False); if (l > 2 && current->contents) lw_push_menu (current->contents); } static void menu_select_item (widget_value *val) { if (val == NULL) val = lw_get_entries (False); /* is match a submenu? */ if (val->contents) { /* enter the submenu */ lw_set_item (val); lw_push_menu (val->contents); } else { /* Execute the menu entry by calling the menu's `select' callback function */ lw_kill_menus (val); } } Lisp_Object command_builder_operate_menu_accelerator (struct command_builder *builder) { /* this function can GC */ struct console *con = XCONSOLE (Vselected_console); Lisp_Object evee = builder->most_current_event; Lisp_Object binding; widget_value *entries; extern int lw_menu_accelerate; /* lwlib.c */ #if 0 { int i; Lisp_Object t; t = builder->current_events; i = 0; while (!NILP (t)) { i++; write_fmt_string (Qexternal_debugging_output, "OPERATE (%d): ",i); print_internal (t, Qexternal_debugging_output, 1); write_c_string (Qexternal_debugging_output, "\n"); t = XEVENT_NEXT (t); } } #endif /* 0 */ /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; /* don't echo menu accelerator keys */ /*reset_key_echo (builder, 1);*/ if (!lw_menu_accelerate) { /* `convert' mouse display to keyboard display by entering the open submenu */ entries = lw_get_entries (False); if (entries->contents) { lw_push_menu (entries->contents); lw_display_menu (CurrentTime); } } /* compare event to the current menu accelerators */ entries=lw_get_entries (True); while (entries) { Lisp_Object accel; accel = VOID_TO_LISP (entries->accel); if (entries->name && !NILP (accel)) { if (event_matches_key_specifier_p (XEVENT (evee), accel)) { /* a match! */ menu_select_item (entries); if (lw_menu_active) lw_display_menu (CurrentTime); reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ return Vmenu_accelerator_map; } } entries = entries->next; } /* try to look up event in menu-accelerator-map */ binding = event_binding_in (evee, Vmenu_accelerator_map, 1); if (NILP (binding)) { /* beep at user for undefined key */ return Qnil; } else { if (EQ (binding, Qmenu_quit)) { /* turn off menus and set quit flag */ lw_kill_menus (NULL); Vquit_flag = Qt; } else if (EQ (binding, Qmenu_up)) { int level = lw_menu_level (); if (level > 2) menu_move_up (); } else if (EQ (binding, Qmenu_down)) { int level = lw_menu_level (); if (level > 2) menu_move_down (); else menu_select_item (NULL); } else if (EQ (binding, Qmenu_left)) { int level = lw_menu_level (); if (level > 3) { lw_pop_menu (); lw_display_menu (CurrentTime); } else menu_move_left (); } else if (EQ (binding, Qmenu_right)) { int level = lw_menu_level (); if (level > 2 && lw_get_entries (False)->contents) { widget_value *current = lw_get_entries (False); if (current->contents) menu_select_item (NULL); } else menu_move_right (); } else if (EQ (binding, Qmenu_select)) menu_select_item (NULL); else if (EQ (binding, Qmenu_escape)) { int level = lw_menu_level (); if (level > 2) { lw_pop_menu (); lw_display_menu (CurrentTime); } else { /* turn off menus quietly */ lw_kill_menus (NULL); } } else if (KEYMAPP (binding)) { /* prefix key */ reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ return binding; } else { /* turn off menus and execute binding */ lw_kill_menus (NULL); reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ return binding; } } if (lw_menu_active) lw_display_menu (CurrentTime); reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ return Vmenu_accelerator_map; } static Lisp_Object menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) { Vmenu_accelerator_prefix = Qnil; Vmenu_accelerator_modifiers = Qnil; Vmenu_accelerator_enabled = Qnil; if (!NILP (errordata)) { /* #### This should call (with-output-to-string (display-error errordata)) but that stuff is all in Lisp currently. */ warn_when_safe_lispobj (Qerror, Qwarning, emacs_sprintf_string_lisp ("%s: %s", Qnil, 2, build_msg_string ("Error in menu accelerators (setting to nil)"), errordata)); } return Qnil; } static Lisp_Object menu_accelerator_safe_compare (Lisp_Object event0) { if (CONSP (Vmenu_accelerator_prefix)) { Lisp_Object t; t=Vmenu_accelerator_prefix; while (!NILP (t) && !NILP (event0) && event_matches_key_specifier_p (XEVENT (event0), Fcar (t))) { t = Fcdr (t); event0 = XEVENT_NEXT (event0); } if (!NILP (t)) return Qnil; } else if (NILP (event0)) return Qnil; else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix)) event0 = XEVENT_NEXT (event0); else return Qnil; return event0; } static Lisp_Object menu_accelerator_safe_mod_compare (Lisp_Object cons) { return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons)) ? Qt : Qnil); } Lisp_Object command_builder_find_menu_accelerator (struct command_builder *builder) { /* this function can GC */ Lisp_Object event0 = builder->current_events; struct console *con = XCONSOLE (Vselected_console); struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); Widget menubar_widget; /* compare entries in event0 against the menu prefix */ if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || XEVENT (event0)->event_type != key_press_event) return Qnil; if (!NILP (Vmenu_accelerator_prefix)) { event0 = condition_case_1 (Qerror, menu_accelerator_safe_compare, event0, menu_accelerator_junk_on_error, Qnil); } if (NILP (event0)) return Qnil; menubar_widget = FRAME_X_MENUBAR_WIDGET (f); if (menubar_widget && CONSP (Vmenu_accelerator_modifiers)) { Lisp_Object fake = Qnil; Lisp_Object last = Qnil; struct gcpro gcpro1; Lisp_Object matchp; widget_value *val; LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; val = lw_get_all_values (id); if (val) { val = val->contents; fake = Fcopy_sequence (Vmenu_accelerator_modifiers); last = fake; while (!NILP (Fcdr (last))) last = Fcdr (last); Fsetcdr (last, Fcons (Qnil, Qnil)); last = Fcdr (last); } fake = Fcons (Qnil, fake); GCPRO1 (fake); while (val) { Lisp_Object accel; accel = VOID_TO_LISP (val->accel); if (val->name && !NILP (accel)) { Fsetcar (last, accel); Fsetcar (fake, event0); matchp = condition_case_1 (Qerror, menu_accelerator_safe_mod_compare, fake, menu_accelerator_junk_on_error, Qnil); if (!NILP (matchp)) { /* we found one! */ lw_set_menu (menubar_widget, val); /* yah - yet another hack. pretend emacs timestamp is the same as an X timestamp, which for the moment it is. (read events.h) */ lw_map_menu (XEVENT (event0)->timestamp); if (val->contents) lw_push_menu (val->contents); lw_display_menu (CurrentTime); /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; /* don't echo menu accelerator keys */ /*reset_key_echo (builder, 1);*/ reset_this_command_keys (Vselected_console, 1); UNGCPRO; return Vmenu_accelerator_map; } } val = val->next; } UNGCPRO; } return Qnil; } int x_kludge_lw_menu_active (void) { return lw_menu_active; } DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* Make the menubar active. Menu items can be selected using menu accelerators or by actions defined in menu-accelerator-map. */ ()) { struct console *con = XCONSOLE (Vselected_console); struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); LWLIB_ID id; widget_value *val; if (NILP (f->menubar_data)) invalid_argument ("Frame has no menubar", Qunbound); id = XPOPUP_DATA (f->menubar_data)->id; val = lw_get_all_values (id); val = val->contents; lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); lw_map_menu (CurrentTime); lw_display_menu (CurrentTime); /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; return Qnil; } #endif /* LWLIB_MENUBARS_LUCID */ void syms_of_menubar_x (void) { #if defined(LWLIB_MENUBARS_LUCID) DEFSUBR (Faccelerate_menu); #endif } void console_type_create_menubar_x (void) { CONSOLE_HAS_METHOD (x, update_frame_menubars); CONSOLE_HAS_METHOD (x, free_frame_menubars); CONSOLE_HAS_METHOD (x, popup_menu); } void reinit_vars_of_menubar_x (void) { last_popup_menu_selection_callback_id = (LWLIB_ID) -1; } void vars_of_menubar_x (void) { reinit_vars_of_menubar_x (); #if defined (LWLIB_MENUBARS_LUCID) Fprovide (intern ("lucid-menubars")); #elif defined (LWLIB_MENUBARS_MOTIF) Fprovide (intern ("motif-menubars")); #elif defined (LWLIB_MENUBARS_ATHENA) Fprovide (intern ("athena-menubars")); #endif }