Mercurial > hg > xemacs-beta
view src/menubar-x.c @ 2367:ecf1ebac70d8
[xemacs-hg @ 2004-11-04 23:05:23 by ben]
commit mega-patch
configure.in: Turn off -Winline and -Wchar-subscripts.
Use the right set of cflags when compiling modules.
Rewrite ldap configuration to separate the inclusion of lber
(needed in recent Cygwin) from the basic checks for the
needed libraries.
add a function for MAKE_JUNK_C; initially code was added to
generate xemacs.def using this, but it will need to be rewritten.
add an rm -f for junk.c to avoid weird Cygwin bug with cp -f onto
an existing file.
Sort list of auto-detected functions and eliminate unused checks for
stpcpy, setlocale and getwd.
Add autodetection of Cygwin scanf problems
BETA: Rewrite section on configure to indicate what flags are important
and what not.
digest-doc.c, make-dump-id.c, profile.c, sorted-doc.c: Add proper decls for main().
make-msgfile.c: Document that this is old junk.
Move proposal to text.c.
make-msgfile.lex: Move proposal to text.c.
make-mswin-unicode.pl: Convert error-generating code so that the entire message will
be seen as a single unrecognized token.
mule/mule-ccl.el: Update docs.
lispref/mule.texi: Update CCL docs.
ldap/eldap.c: Mule-ize.
Use EXTERNAL_LIST_LOOP_2 instead of deleted EXTERNAL_LIST_LOOP.
* XEmacs 21.5.18 "chestnut" is released.
---------------------------------------------------------------
MULE-RELATED WORK:
---------------------------------------------------------------
---------------------------
byte-char conversion
---------------------------
buffer.c, buffer.h, insdel.c, text.c: Port FSF algorithm for byte-char conversion, replacing broken
previous version. Track the char position of the gap. Add
functions to do char-byte conversion downwards as well as upwards.
Move comments about algorithm workings to internals manual.
---------------------------
work on types
---------------------------
alloc.c, console-x-impl.h, dump-data.c, dump-data.h, dumper.c, dialog-msw.c, dired-msw.c, doc.c, editfns.c, esd.c, event-gtk.h, event-msw.c, events.c, file-coding.c, file-coding.h, fns.c, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-shared.c, glyphs-x.c, glyphs.c, glyphs.h, gui.c, hpplay.c, imgproc.c, intl-win32.c, lrecord.h, lstream.c, keymap.c, lisp.h, libsst.c, linuxplay.c, miscplay.c, miscplay.h, mule-coding.c, nas.c, nt.c, ntheap.c, ntplay.c, objects-msw.c, objects-tty.c, objects-x.c, print.c, process-nt.c, process.c, redisplay.h, select-common.h, select-gtk.c, select-x.c, sgiplay.c, sound.c, sound.h, sunplay.c, sysfile.h, sysdep.c, syswindows.h, text.c, unexnt.c, win32.c, xgccache.c: Further work on types. This creates a full set of types for all
the basic semantics of `char' that I have so far identified, so that
its semantics can always be identified for the purposes of proper
Mule-safe code, and the raw use of `char' always avoided.
(1) More type renaming, for consistency of naming.
Char_ASCII -> Ascbyte
UChar_ASCII -> UAscbyte
Char_Binary -> CBinbyte
UChar_Binary -> Binbyte
SChar_Binary -> SBinbyte
(2) Introduce Rawbyte, CRawbyte, Boolbyte, Chbyte, UChbyte, and
Bitbyte and use them.
(3) New types Itext, Wexttext and Textcount for separating out
the concepts of bytes and textual units (different under UTF-16
and UTF-32, which are potential internal encodings).
(4) qxestr*_c -> qxestr*_ascii.
lisp.h: New; goes with other qxe() functions. #### Maybe goes in a
different section.
lisp.h: Group generic int-type defs together with EMACS_INT defs.
lisp.h: * lisp.h (WEXTTEXT_IS_WIDE)
New defns.
lisp.h: New type to replace places where int occurs as a boolean.
It's signed because occasionally people may want to use -1 as
an error value, and because unsigned ints are viral -- see comments
in the internals manual against using them.
dynarr.c: int -> Bytecount.
---------------------------
Mule-izing
---------------------------
device-x.c: Partially Mule-ize.
dumper.c, dumper.h: Mule-ize. Use Rawbyte. Use stderr_out not printf. Use wext_*().
sysdep.c, syswindows.h, text.c: New Wexttext API for manipulation of external text that may be
Unicode (e.g. startup code under Windows).
emacs.c: Mule-ize. Properly deal with argv in external encoding.
Use wext_*() and Wexttext. Use Rawbyte.
#if 0 some old junk on SCO that is unlikely to be correct.
Rewrite allocation code in run-temacs.
emacs.c, symsinit.h, win32.c: Rename win32 init function and call it even earlier, to
initialize mswindows_9x_p even earlier, for use in startup code
(XEUNICODE_P).
process.c: Use _wenviron not environ under Windows, to get Unicode environment
variables.
event-Xt.c: Mule-ize drag-n-drop related stuff.
dragdrop.c, dragdrop.h, frame-x.c: Mule-ize.
text.h: Add some more stand-in defines for particular kinds of conversion;
use in Mule-ization work in frame-x.c etc.
---------------------------
Freshening
---------------------------
intl-auto-encap-win32.c, intl-auto-encap-win32.h: Regenerate.
---------------------------
Unicode-work
---------------------------
intl-win32.c, syswindows.h: Factor out common options to MultiByteToWideChar and
WideCharToMultiByte. Add convert_unicode_to_multibyte_malloc()
and convert_unicode_to_multibyte_dynarr() and use. Add stuff for
alloca() conversion of multibyte/unicode.
alloc.c: Use dfc_external_data_len() in case of unicode coding system.
alloc.c, mule-charset.c: Don't zero out and reinit charset Unicode tables. This fucks up
dump-time loading. Anyway, either we load them at dump time or
run time, never both.
unicode.c: Dump the blank tables as well.
---------------------------------------------------------------
DOCUMENTATION, MOSTLY MULE-RELATED:
---------------------------------------------------------------
EmacsFrame.c, emodules.c, event-Xt.c, fileio.c, input-method-xlib.c, mule-wnnfns.c, redisplay-gtk.c, redisplay-tty.c, redisplay-x.c, regex.c, sysdep.c: Add comment about Mule work needed.
text.h: Add more documentation describing why DFC routines were not written
to return their value. Add some other DFC documentation.
console-msw.c, console-msw.h: Add pointer to docs in win32.c.
emacs.c: Add comments on sources of doc info.
text.c, charset.h, unicode.c, intl-win32.c, intl-encap-win32.c, text.h, file-coding.c, mule-coding.c: Collect background comments and related to text matters and
internationalization, and proposals for work to be done, in text.c
or Internals manual, stuff related to specific textual API's in
text.h, and stuff related to internal implementation of Unicode
conversion in unicode.c. Put lots of pointers to the comments to
make them easier to find.
s/mingw32.h, s/win32-common.h, s/win32-native.h, s/windowsnt.h, win32.c: Add bunches of new documentation on the different kinds of
builds and environments under Windows and how they work.
Collect this info in win32.c. Add pointers to these docs in
the relevant s/* files.
emacs.c: Document places with long comments.
Remove comment about exiting, move to internals manual, put
in pointer.
event-stream.c: Move docs about event queues and focus to internals manual, put
in pointer.
events.h: Move docs about event stream callbacks to internals manual, put
in pointer.
profile.c, redisplay.c, signal.c: Move documentation to the Internals manual.
process-nt.c: Add pointer to comment in win32-native.el.
lisp.h: Add comments about some comment conventions.
lisp.h: Add comment about the second argument.
device-msw.c, redisplay-msw.c: @@#### comments are out-of-date.
---------------------------------------------------------------
PDUMP WORK (MOTIVATED BY UNICODE CHANGES)
---------------------------------------------------------------
alloc.c, buffer.c, bytecode.c, console-impl.h, console.c, device.c, dumper.c, lrecord.h, elhash.c, emodules.h, events.c, extents.c, frame.c, glyphs.c, glyphs.h, mule-charset.c, mule-coding.c, objects.c, profile.c, rangetab.c, redisplay.c, specifier.c, specifier.h, window.c, lstream.c, file-coding.h, file-coding.c: PDUMP:
Properly implement dump_add_root_block(), which never worked before,
and is necessary for dumping Unicode tables.
Pdump name changes for accuracy:
XD_STRUCT_PTR -> XD_BLOCK_PTR.
XD_STRUCT_ARRAY -> XD_BLOCK_ARRAY.
XD_C_STRING -> XD_ASCII_STRING.
*_structure_* -> *_block_*.
lrecord.h: some comments added about
dump_add_root_block() vs dump_add_root_block_ptr().
extents.c: remove incorrect comment about pdump problems with gap array.
---------------------------------------------------------------
ALLOCATION
---------------------------------------------------------------
abbrev.c, alloc.c, bytecode.c, casefiddle.c, device-msw.c, device-x.c, dired-msw.c, doc.c, doprnt.c, dragdrop.c, editfns.c, emodules.c, file-coding.c, fileio.c, filelock.c, fns.c, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-x.c, gui-msw.c, gui-x.c, imgproc.c, intl-win32.c, lread.c, menubar-gtk.c, menubar.c, nt.c, objects-msw.c, objects-x.c, print.c, process-nt.c, process-unix.c, process.c, realpath.c, redisplay.c, search.c, select-common.c, symbols.c, sysdep.c, syswindows.h, text.c, text.h, ui-byhand.c: New macros {alloca,xnew}_{itext,{i,ext,raw,bin,asc}bytes} for
more convenient allocation of these commonly requested items.
Modify functions to use alloca_ibytes, alloca_array, alloca_extbytes,
xnew_ibytes, etc. also XREALLOC_ARRAY, xnew.
alloc.c: Rewrite the allocation functions to factor out repeated code.
Add assertions for freeing dumped data.
lisp.h: Moved down and consolidated with other allocation stuff.
lisp.h, dynarr.c: New functions for allocation that's very efficient when mostly in
LIFO order.
lisp.h, text.c, text.h: Factor out some stuff for general use by alloca()-conversion funs.
text.h, lisp.h: Fill out convenience routines for allocating various kinds of
bytes and put them in lisp.h. Use them in place of xmalloc(),
ALLOCA().
text.h: Fill out the convenience functions so the _MALLOC() kinds match
the alloca() kinds.
---------------------------------------------------------------
ERROR-CHECKING
---------------------------------------------------------------
text.h: Create ASSERT_ASCTEXT_ASCII() and ASSERT_ASCTEXT_ASCII_LEN()
from similar Eistring checkers and change the Eistring checkers to
use them instead.
---------------------------------------------------------------
MACROS IN LISP.H
---------------------------------------------------------------
lisp.h: Redo GCPRO declarations. Create a "base" set of functions that can
be used to generate any kind of gcpro sets -- regular, ngcpro,
nngcpro, private ones used in GC_EXTERNAL_LIST_LOOP_2.
buffer.c, callint.c, chartab.c, console-msw.c, device-x.c, dialog-msw.c, dired.c, extents.c, ui-gtk.c, rangetab.c, nt.c, mule-coding.c, minibuf.c, menubar-msw.c, menubar.c, menubar-gtk.c, lread.c, lisp.h, gutter.c, glyphs.c, glyphs-widget.c, fns.c, fileio.c, file-coding.c, specifier.c: Eliminate EXTERNAL_LIST_LOOP, which does not check for circularities.
Use EXTERNAL_LIST_LOOP_2 instead or EXTERNAL_LIST_LOOP_3
or EXTERNAL_PROPERTY_LIST_LOOP_3 or GC_EXTERNAL_LIST_LOOP_2
(new macro). Removed/redid comments on EXTERNAL_LIST_LOOP.
---------------------------------------------------------------
SPACING FIXES
---------------------------------------------------------------
callint.c, hftctl.c, number-gmp.c, process-unix.c: Spacing fixes.
---------------------------------------------------------------
FIX FOR GEOMETRY PROBLEM IN FIRST FRAME
---------------------------------------------------------------
unicode.c: Add workaround for newlib bug in sscanf() [should be fixed by
release 1.5.12 of Cygwin].
toolbar.c: bug fix for problem of initial frame being 77 chars wide on Windows.
will be overridden by my other ws.
---------------------------------------------------------------
FIX FOR LEAKING PROCESS HANDLES:
---------------------------------------------------------------
process-nt.c: Fixes for leaking handles. Inspired by work done by Adrian Aichner
<adrian@xemacs.org>.
---------------------------------------------------------------
FIX FOR CYGWIN BUG (Unicode-related):
---------------------------------------------------------------
unicode.c: Add workaround for newlib bug in sscanf() [should be fixed by
release 1.5.12 of Cygwin].
---------------------------------------------------------------
WARNING FIXES:
---------------------------------------------------------------
console-stream.c: `reinit' is unused.
compiler.h, event-msw.c, frame-msw.c, intl-encap-win32.c, text.h: Add stuff to deal with ANSI-aliasing warnings I got.
regex.c: Gather includes together to avoid warning.
---------------------------------------------------------------
CHANGES TO INITIALIZATION ROUTINES:
---------------------------------------------------------------
buffer.c, emacs.c, console.c, debug.c, device-x.c, device.c, dragdrop.c, emodules.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, events.c, extents.c, faces.c, file-coding.c, fileio.c, font-lock.c, frame-msw.c, glyphs-widget.c, glyphs.c, gui-x.c, insdel.c, lread.c, lstream.c, menubar-gtk.c, menubar-x.c, minibuf.c, mule-wnnfns.c, objects-msw.c, objects.c, print.c, scrollbar-x.c, search.c, select-x.c, text.c, undo.c, unicode.c, window.c, symsinit.h: Call reinit_*() functions directly from emacs.c, for clarity.
Factor out some redundant init code. Move disallowed stuff
that had crept into vars_of_glyphs() into complex_vars_of_glyphs().
Call init_eval_semi_early() from eval.c not in the middle of
vars_of_() in emacs.c since there should be no order dependency
in the latter calls.
---------------------------------------------------------------
ARMAGEDDON:
---------------------------------------------------------------
alloc.c, emacs.c, lisp.h, print.c: Rename inhibit_non_essential_printing_operations to
inhibit_non_essential_conversion_operations.
text.c: Assert on !inhibit_non_essential_conversion_operations.
console-msw.c, print.c: Don't do conversion in SetConsoleTitle or FindWindow to avoid
problems during armageddon. Put #errors for NON_ASCII_INTERNAL_FORMAT
in places where problems would arise.
---------------------------------------------------------------
CHANGES TO THE BUILD PROCEDURE:
---------------------------------------------------------------
config.h.in, s/cxux.h, s/usg5-4-2.h, m/powerpc.h: Add comment about correct ordering of this file.
Rearrange everything to follow this -- put all #undefs together
and before the s&m files. Add undefs for HAVE_ALLOCA, C_ALLOCA,
BROKEN_ALLOCA_IN_FUNCTION_CALLS, STACK_DIRECTION. Remove unused
HAVE_STPCPY, HAVE_GETWD, HAVE_SETLOCALE.
m/gec63.h: Deleted; totally broken, not used at all, not in FSF.
m/7300.h, m/acorn.h, m/alliant-2800.h, m/alliant.h, m/altos.h, m/amdahl.h, m/apollo.h, m/att3b.h, m/aviion.h, m/celerity.h, m/clipper.h, m/cnvrgnt.h, m/convex.h, m/cydra5.h, m/delta.h, m/delta88k.h, m/dpx2.h, m/elxsi.h, m/ews4800r.h, m/gould.h, m/hp300bsd.h, m/hp800.h, m/hp9000s300.h, m/i860.h, m/ibmps2-aix.h, m/ibmrs6000.h, m/ibmrt-aix.h, m/ibmrt.h, m/intel386.h, m/iris4d.h, m/iris5d.h, m/iris6d.h, m/irist.h, m/isi-ov.h, m/luna88k.h, m/m68k.h, m/masscomp.h, m/mg1.h, m/mips-nec.h, m/mips-siemens.h, m/mips.h, m/news.h, m/nh3000.h, m/nh4000.h, m/ns32000.h, m/orion105.h, m/pfa50.h, m/plexus.h, m/pmax.h, m/powerpc.h, m/pyrmips.h, m/sequent-ptx.h, m/sequent.h, m/sgi-challenge.h, m/symmetry.h, m/tad68k.h, m/tahoe.h, m/targon31.h, m/tekxd88.h, m/template.h, m/tower32.h, m/tower32v3.h, m/ustation.h, m/vax.h, m/wicat.h, m/xps100.h: Delete C_ALLOCA, HAVE_ALLOCA, STACK_DIRECTION,
BROKEN_ALLOCA_IN_FUNCTION_CALLS. All of this is auto-detected.
When in doubt, I followed recent FSF sources, which also have
these things deleted.
author | ben |
---|---|
date | Thu, 04 Nov 2004 23:08:28 +0000 |
parents | 04bc9d2f42c7 |
children | 3d8143fc88e1 |
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, 2003 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-impl.h" #include "events.h" #include "frame-impl.h" #include "gui.h" #include "keymap.h" #include "menubar.h" #include "opaque.h" #include "window-impl.h" #include "console-x-impl.h" #include "EmacsFrame.h" #include "../lwlib/lwlib.h" static int set_frame_menubar (struct frame *f, int deep_p, int first_time_p); #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)) { Ibyte *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 (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 ((Ibyte *) "=="); 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; } struct menu_item_descriptor_to_widget_value { Lisp_Object desc; int menu_type, deep_p, filter_p; widget_value *wv; }; static Lisp_Object protected_menu_item_descriptor_to_widget_value_1 (void *gack) { struct menu_item_descriptor_to_widget_value *midtwv = (struct menu_item_descriptor_to_widget_value *) gack; int count = begin_gc_forbidden (); /* Can't GC! */ midtwv->wv = menu_item_descriptor_to_widget_value_1 (midtwv->desc, midtwv->menu_type, midtwv->deep_p, midtwv->filter_p, 0); unbind_to (count); return Qnil; } /* Inside of the pre_activate_callback, we absolutely need to protect against errors, esp. but not exclusively in the filter code. (We do other evalling, too.) We also need to reenable quit checking, which was disabled by next_event_internal() so as to read C-g as an event. */ static widget_value * protected_menu_item_descriptor_to_widget_value (Lisp_Object desc, int menu_type, int deep_p, int filter_p) { struct menu_item_descriptor_to_widget_value midtwv; int depth = internal_bind_int (&in_menu_callback, 1); Lisp_Object retval; midtwv.desc = desc; midtwv.menu_type = menu_type; midtwv.deep_p = deep_p; midtwv.filter_p = filter_p; retval = event_stream_protect_modal_loop ("Error during menu callback", protected_menu_item_descriptor_to_widget_value_1, &midtwv, UNINHIBIT_QUIT); unbind_to (depth); if (UNBOUNDP (retval)) return 0; return midtwv.wv; } /* The two callers of menu_item_descriptor_to_widget_value may both run while in redisplay. Some descriptor to widget value conversions call Feval, and at least one calls QUIT. Hence, we have to establish protection here.. */ 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 */ { struct menu_item_descriptor_to_widget_value midtwv; Lisp_Object retval; midtwv.desc = desc; midtwv.menu_type = menu_type; midtwv.deep_p = deep_p; midtwv.filter_p = filter_p; retval = call_trapping_problems (Qevent, "Error during menu construction", 0, NULL, protected_menu_item_descriptor_to_widget_value_1, &midtwv); if (UNBOUNDP (retval)) return NULL; return midtwv.wv; } /* 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 UNUSED (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; /* 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); wv = (protected_menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, 1, 0)); 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); /* Now that we've destructively modified part of the widget value hierarchy, our list of protected callbacks will no longer be valid, so we need to recompute it. */ gcpro_popup_callbacks (FRAME_X_MENUBAR_ID (f)); } else if (!FRAME_X_MENUBAR_ID (f)) return; else { /* #### - 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. */ run_hook_trapping_problems (Qmenubar, Qactivate_menubar_hook, INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); set_frame_menubar (f, 1, 0); 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 (!FRAME_X_MENUBAR_ID (f)) FRAME_X_MENUBAR_ID (f) = new_lwlib_id (); /***** now store into the menubar widget, creating it if necessary *****/ id = FRAME_X_MENUBAR_ID (f); 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); /* Buried inside of the lwlib data are pointers to Lisp objects that may have been freshly created. They need to be GC-protected, so snarf them now and record them into the popup-data object associated with the frame. */ gcpro_popup_callbacks (id); FRAME_X_MENUBAR_CONTENTS_UP_TO_DATE (f) = deep_p; FRAME_X_LAST_MENUBAR_BUFFER (f) = 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 UNUSED (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 = EVENT_TIMESTAMP (eev); btn->button = EVENT_BUTTON_BUTTON (eev); btn->root = RootWindowOfScreen (XtScreen (daddy)); btn->subwindow = (Window) NULL; btn->x = EVENT_BUTTON_X (eev); btn->y = EVENT_BUTTON_Y (eev); 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 || !FRAME_X_MENUBAR_ID (f) || (!EQ (FRAME_X_LAST_MENUBAR_BUFFER (f), 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 = FRAME_X_MENUBAR_ID (f); lw_destroy_all_widgets (id); ungcpro_popup_callbacks (id); FRAME_X_MENUBAR_ID (f) = 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 (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 UNUSED (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 (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 (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 (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 = FRAME_X_MENUBAR_ID (f); 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 (!FRAME_X_MENUBAR_ID (f)) invalid_argument ("Frame has no menubar", Qunbound); id = FRAME_X_MENUBAR_ID (f); 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) { #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 }